1 ;;; tinyrmail.el --- RMAIL add-ons, pgp, mime labels, Spam complaint.
3 ;; This file is not part of Emacs
7 ;; Copyright (C) 1996-2007 Jari Aalto
10 ;; Maintainer: Jari Aalto
12 ;; To get information on this program, call M-x tinyrmail-version.
13 ;; Look at the code with folding.el.
17 ;; This program is free software; you can redistribute it and/or modify it
18 ;; under the terms of the GNU General Public License as published by the Free
19 ;; Software Foundation; either version 2 of the License, or (at your option)
22 ;; This program is distributed in the hope that it will be useful, but
23 ;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
24 ;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
27 ;; You should have received a copy of the GNU General Public License
28 ;; along with program; see the file COPYING. If not, write to the
29 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
30 ;; Boston, MA 02110-1301, USA.
32 ;; Visit <http://www.gnu.org/copyleft/gpl.html> for more information
37 ;; ....................................................... &t-install ...
39 ;; ** NOTE: 1998-01 This file is no longer maintained. Plese see Gnus.
41 ;; Put this file on your Emacs-Lisp load path, add following into your
42 ;; ~/.emacs startup file. Rip code with with tinylib.el/ti::package-rip-magic
44 ;; (require 'tinyrmail)
46 ;; or prefer this; your .emacs loads up much quicker
48 ;; (autoload 'tinyrmail-rmail-summary-by-labels-and "tinyrmail" "" t)
49 ;; (autoload 'tinyrmail-install "tinyrmail" "" t)
50 ;; (add-hook 'rmail-mode-hook 'tinyrmail-install)
52 ;; If you have any questions, use this function
54 ;; M-x tinyrmail-submit-bug-report ,send bug report
60 ;; ..................................................... &t-commentary ...
63 ;; Preface, overview of features
65 ;; 1998-01: This file is no longer supported. Prefer to use Gnus
66 ;; instead. There is module *tinygnus.el* which provides additional
69 ;; o Detect PGP, MIME mail and label incoming messages accordingly.
70 ;; User can add more checking functions and labels to incoming email
72 ;; o New label summary cmd with AND e.g. finding {pgp,v} verified pgp
73 ;; o Flag incoming mail as deleted by regexp.
74 ;; o "S" command for Spam message reply.
75 ;; o Commands to fix your RMAIL messages.
76 ;; o advice: "n" and "p" do not to auto display msg in Summary buffer
77 ;; o advice: mouse click in Summary does not automatically update msg
78 ;; o advice: `rmail-ignored-headers' now reformats old messages too.
82 ;; This little package offers some autmatic detection of PGP
83 ;; MIME mails: It attaches labels to your incoming mails.
84 ;; There is also new summary function, which enables you to
85 ;; make a query by ANDing the labels in your RMAIL.
87 ;; This means, that you can now classify your message, like this:
94 ;; Eg. For PGP mails I have
97 ;; {pgp,v} -- verified signature
98 ;; {pgp,u} -- not verified
99 ;; {pgp,v,e} -- verified and encrypted
101 ;; The normail rmail's summary function gives you the OR summary, which
102 ;; would mean, that if you wanted symmary by {pgp,v}, it would give
103 ;; you all mail that has either {v} or {pgp} somewhere. Well, this
104 ;; summary is not suitable if you use one CHAR to denote attributes
105 ;; of your base-identifiers (multichar)
107 ;; Automatic deletion of incoming mail
109 ;; There is default function to mark messages as deleted according
110 ;; to regexp. Please configure this variable to suit your needs:
112 ;; tinyrmail-:delete-regexp
114 ;; If you want more personal control whether the mail
115 ;; should be deleted or not, please remove the default delete function
118 ;; (add-hook 'tinyrmail-:load-hook 'my-tinyrmail-:load-hook)
120 ;; (defun my-tinyrmail-:load-hook ()
121 ;; "Cancel some default settings and modify parameters."
122 ;; (remove-hook 'tinyrmail-:get-new-mail-hook
123 ;; 'tinyrmail-delete-function)
124 ;; (add-hook 'tinyrmail-:get-new-mail-hook
125 ;; 'my-rmail-delete-function))
128 ;; (defun my-rmail-delete-function ()
131 ;; New commands in RMAIL
133 ;; Refer to function tinyrmail-define-default-keys for exact setup.
134 ;; Currently the only new command added is
136 ;; "L" tinyrmail-rmail-summary-by-labels-and
138 ;; Fixing RMAIL format
140 ;; Sometimes you may get following error after you have hit "g"
141 ;; to get new mail: "Cannot convert to babyl". The reason for
142 ;; this behavior is still not quite clear to me, but the cause
143 ;; is in the incoming message that does not have
147 ;; Field at the beginning of message. I have seen even some garbage
148 ;; Prepended to field so that it looked like
152 ;; What have to start editing the RMAIL file directly to fix its
153 ;; format. Change the mode to text-mode, run M-x widen and search the
154 ;; last message that rmail was not able to read. You will easily find the
155 ;; point where "**** EOOH" markers do not appear any more.
157 ;; Now starts the fixing part to make rmail happy again:
159 ;; o Make sure From line is left flushed. Edit if needed and put
160 ;; lines in their right places.
161 ;; o Select all individual message's headers at a time.
162 ;; o Call function tinyrmail-fix-make-rmail-message-header
163 ;; which you should propably bound to some convenient key.
164 ;; The ESC-z combination is propably free for temporary use.
165 ;; (local-set-key "\ez" 'tinyrmail-fix-make-rmail-message-header)
167 ;; After you have converted all headers to rmail format, you can
168 ;; start rmail again with command
172 ;; If you made any mistakes, rmail will let you know and you have to
173 ;; repeat the header fixing again. (possibly removing the prevous
174 ;; EOOOH markers and reconverting them). We aren't quite finished
175 ;; yet. You see, on error, rmail leaves the read mail into your home
176 ;; directory. Please check that
178 ;; ~/.newmail-USERNAME
180 ;; file doesn't contain any new message that aren't already in your RMAIL
181 ;; buffer. If there is only old message, delete that file. Now we
182 ;; have finished and you can again use "g" to get new mail.
184 ;; Standard Rmail distribution changes
186 ;; This package changes the standard Rmail distribution sligtly and here
187 ;; summary. If you want to disable these features or only use some of
188 ;; them, you have to put separate configuration to your .emacs.
191 ;; (setq tinyrmail-:load-hook '(tinyrmail-install))
193 ;; To disable advices, you do
195 ;; (setq tinyrmail-:load-hook '(tinyrmail-install my-tinyrmail-install))
197 ;; (defun my-tinyrmail-install ()
198 ;; (ti::advice-control
199 ;; '(rmail-show-message
200 ;; rmail-summary-enable
201 ;; rmail-summary-next-msg
208 ;; `tinyrmail-:forms-rmail'
210 ;; o Every time RMAIL package is loaded these forms are executed.
211 ;; o These define some keybindings to summary buffer
212 ;; that I have found appropriate. Mouse-2 selects message
213 ;; (and does not yank as the original). RET key also selects message.
214 ;; o The post command hook is cleared so that you can search regexp
215 ;; in summary buffer. Normally moving a cursor would move the
216 ;; current message too.
217 ;; o The "q" quit key is too easily pressed and I have removed it
218 ;; alltogether. If I really want to quit RMAIL, I usually
223 ;; *rmail-show-message* active
225 ;; The message's headers are now always reformatted. If you change
226 ;; variable `rmail-ignored-headers', the old messages are not affected
227 ;; until you "t"oggle headers. This advice does it for you
228 ;; automatically every time you select message. This advice slows
229 ;; message displaying a bit, but for me, it isn't very noticeable.
230 ;; You can very well turn this off if you dont' change content of
231 ;; `rmail-ignored-headers'.
233 ;; *rmail-summary-enable* active
235 ;; This replaces whole function. The original function did automatic
236 ;; message update whenever you moved around summary buffer. Now you
237 ;; can keep summary buffer search separated from the current
238 ;; message displayed.
240 ;; *rmail-summary-next-msg* active
251 ;;{{{ setup: libraries
253 (require 'rmail) ;Uses macros from there
257 (autoload 'rmail-new-summary "rmailsum"))
259 (eval-when-compile (ti::package-use-dynamic-compilation))
261 (ti::package-defgroup-tiny TinyRmail tinyrmail-: mail
262 "Additional features to RMAIL.
265 o Detect PGP, MIME mail and label incoming messages accordingly.
266 User can add more checking functions and labels to incoming email
268 o New label summary cmd with AND, e.g. {pgp,v} for verified pgp mails.")
273 (defcustom tinyrmail-:load-hook '(tinyrmail-install tinyrmail-install-forms)
274 "*Hook that is run when package is loaded."
278 (defcustom tinyrmail-:rmail-get-new-mail-before-hook nil
279 "*Additional hook added by advice in package tinyrmail.el.
280 Hook run just before new mail is fetched.
281 Contain default function `tinyrmail-rmail-get-new-mail-before-function',
282 which saves the Rmail message pointers before getting new mail."
286 (defcustom tinyrmail-:get-new-mail-hook nil
287 "*Hook run inside each _new_ mail message.
288 The default function `tinyrmail-delete-function' reads variable
289 `tinyrmail-:delete-regexp' and marks buffer as deleted if the regexp
290 matches message contents."
295 ;;{{{ setup: public, user configurable
297 (defcustom tinyrmail-:delete-regexp
300 "\\|this is your chance.*money")
301 "*Mark messge deleted if this regexp match.
302 If this regexp is nil, no mail is marked as deleted.
303 This variable is efective only if `tinyrmail-delete-function' is
304 installed into `tinyrmail-:get-new-mail-hook'."
305 :type '(string :tag "Regexp")
308 (defcustom tinyrmail-:label-table
309 '((ti::mail-pgp-p "pgp")
310 (ti::mail-mime-p "mime"))
311 "*Labels to attach to new RMAIL messages.
314 '((CHECK-FUNCTION STRING-OR-SYMBOL) (F S) ..).
316 The STRING-OR-SYMBOL may be either \"string\" or variable name
317 'lisp-var, where its `symbol-value' is used.
319 The CHECK-FUNCTION is run without arguments inside every new
320 message and it should return. This can also be a lisp form if
321 the elt is not function symbol.
323 nil ,if no action should be taken
324 t ,if the STRING-OR-SYMBOL should be used for labelling
325 string ,that string is used for labelling."
328 (function :tag "Check function")
331 (string :tag "String Label")
332 (symbol :tag "Var Symbol"))))
338 (defvar tinyrmail-:rmail-info-list nil
339 "Values of saved message counters before we get new mail.")
341 (defconst tinyrmail-:forms-rmail
343 (when (boundp 'rmail-summary-mode-map)
346 ;; mouse-2 is paste, move it to select a buffer.
347 ;; See the rmail advices.
348 (define-key rmail-summary-mode-map [down-mouse-2]
349 'rmail-summary-goto-msg)
350 (define-key rmail-summary-mode-map [mouse-2]
351 'rmail-summary-goto-msg))
353 (define-key rmail-summary-mode-map [(button2up)]
354 'rmail-summary-goto-msg)
355 (define-key rmail-summary-mode-map [(button2)]
356 'rmail-summary-goto-msg)))
357 ;; Enter selects a message too
358 (define-key rmail-summary-mode-map "\C-m" 'rmail-summary-goto-msg)
359 ;; rmailsum.el makes this buffer local, loop all rmail summary
360 ;; buffers and remove function from post-command-hook.
361 (ti::dolist-buffer-list
362 (eq major-mode 'rmail-summary-mode)
366 (remove-hook 'post-command-hook 'rmail-summary-rmail-update)))
367 ;; disable "quit", it's too risky. I want to be in RMAIL,
368 ;; and only there hit the "q" key.
370 (define-key rmail-summary-mode-map "q" 'ignore))
371 (when (boundp 'rmail-mode-map)
372 (define-key rmail-mode-map "q"
376 (if (y-or-n-p "Really quit RMAIL ")
378 "Additional forms to `after-load-alist'.
379 Set this variable to '(progn) if you want to disable these features.")
384 ;;;###autoload (autoload 'tinyrmail-version "tinyrmail" "Display commentary." t)
387 (ti::macrof-version-bug-report
390 tinyrmail-:version-id
391 "$Id: tinyrmail.el,v 2.44 2007/05/01 17:20:59 jaalto Exp $"
392 '(tinyrmail-:version-id
393 tinyrmail-:rmail-info-list
395 tinyrmail-:rmail-get-new-mail-before-hook
396 tinyrmail-:get-new-mail-hook
397 tinyrmail-:delete-regexp
398 tinyrmail-:label-table)))
403 ;;; ----------------------------------------------------------------------
405 ;;;###autoload (autoload 'tinyrmail-install-files "tinyrmail" t t)
406 (ti::macrof-install-pgp-tar tinyrmail-install-files "tinyrmail.el")
408 ;;; ----------------------------------------------------------------------
410 (defun tinyrmail-install-forms ()
411 "Some other things to do to get all installed.
415 (when (boundp 'rmail-summary-mode-map)
416 (eval tinyrmail-:forms-rmail)) ;run it immediately
418 ((not (fboundp 'eval-after-load))
421 (eval tinyrmail-:forms-rmail))
422 ((fboundp 'eval-after-load)
423 ;; Quiet XEmacs 19.14 compiler who says this function doesn't exist
424 (ti::funcall 'eval-after-load "rmailsum" tinyrmail-:forms-rmail)
425 (ti::funcall 'eval-after-load "rmail" tinyrmail-:forms-rmail))))
427 ;;; ----------------------------------------------------------------------
428 ;;; - If more commnds are added, I make this a separate minor mode...
430 (defun tinyrmail-define-default-keys ()
431 "Define keys to various maps."
433 ;; Making summaries by ANDING labels.
434 (when (boundp 'rmail-mode-map)
435 (define-key rmail-mode-map "L" 'tinyrmail-rmail-summary-by-labels-and))
436 ;; This is not loaded, that's why symbol-value to shut up byte
438 (when (boundp 'rmail-summary-mode-map)
440 (symbol-value 'rmail-summary-mode-map)
442 'tinyrmail-rmail-summary-by-labels-and)))
444 ;;; ----------------------------------------------------------------------
446 (defun tinyrmail-install-advices (&optional remove verb)
447 "Install advices. Optionally REMOVE advices. VERB."
450 '(rmail-get-new-mail)
456 ;;; ----------------------------------------------------------------------
458 (defun tinyrmail-install (&optional remove)
459 "Install package hooks. Optionally REMOVE installation.
460 Can't restore changes to keymaps."
462 (let* ((f (if remove 'remove-hook 'add-hook)))
463 ;; Set up RMAIL for PGP
464 (funcall f 'rmail-get-new-mail-hook 'tinyrmail-rmail-get-new-mail-function)
465 (funcall f 'tinyrmail-:rmail-get-new-mail-before-hook
466 'tinyrmail-rmail-get-new-mail-before-function)
468 (funcall f 'rmail-mode-hook 'tinyrmail-define-default-keys)
469 (funcall f 'rmail-summary-mode-hook 'tinyrmail-define-default-keys)
470 (funcall f 'gnus-article-mode-hook 'tinyrmail-define-default-keys)
471 (tinyrmail-define-default-keys) ;Install immediately too
472 (tinyrmail-install-advices remove)))
477 ;;; ----------------------------------------------------------------------
481 (defun tinyrmail-rmail-summary-by-labels-and (labels)
482 "Display a summary of all messages with one or more LABELS.
483 LABELS should be a string containing the desired labels, separated by commas.
484 This summary is prduced by _ANDING_ the labels."
485 (interactive "s(AND) Labels to summarize by: ")
486 (if (string= labels "")
487 (setq labels (or rmail-last-multi-labels
488 (error "No label specified"))))
489 (setq rmail-last-multi-labels labels)
490 (rmail-new-summary (concat "labels " labels)
491 (list 'rmail-summary-by-labels labels)
492 'tinyrmail-rmail-message-labels-and-p
493 ;; convert to list of label string
495 (split-string labels "[ ,]+")))
497 ;;; ----------------------------------------------------------------------
499 (defun tinyrmail-rmail-message-labels-and-p (msg labels)
500 "Check and condition in MSG nbr with LABELS LIST."
501 (let* ((copy labels) ;since labels list vanishes in loop
506 (goto-char (rmail-msgbeg msg))
509 ;; May look like this:
512 (if (looking-at (concat ".* " elt ","))
514 ;; Must have as many hits as labels passed to function
515 (eq (length copy) i)))
518 ;;{{{ rmail, new message
520 ;;; ----------------------------------------------------------------------
522 (defun tinyrmail-delete-function ()
523 "Mark messages as deleted if it find regexp `tinyrmail-:delete-regexp'.
524 This function is in `tinyrmail-:get-new-mail-hook'."
526 (if (and (stringp tinyrmail-:delete-regexp)
527 (re-search-forward tinyrmail-:delete-regexp nil t))
528 (rmail-delete-message)))
530 ;;; ----------------------------------------------------------------------
532 (defsubst tinyrmail-rmail-new-message-ptr ()
533 "Return first new message NBR.
534 Function must be called only after the \"g\" key, in `rmail-get-new-mail'."
535 (if (and tinyrmail-:rmail-info-list
536 (not (eq (car tinyrmail-:rmail-info-list)
537 rmail-total-messages))
538 (integerp (car tinyrmail-:rmail-info-list)))
539 (1+ (car tinyrmail-:rmail-info-list))
540 ;; Whan you first hit M-x RMAIL, this tells you the first message
541 (rmail-first-unseen-message)))
543 ;;; ----------------------------------------------------------------------
545 (defun tinyrmail-rmail-get-new-mail-function ()
546 "Loop over every incoming mail message and do labelling."
547 (let* ((table tinyrmail-:label-table)
548 (rmail-current-message rmail-current-message)
554 ;; Is there new mail, maybe some of them are not read yet?
555 (setq nbr (tinyrmail-rmail-new-message-ptr))
557 (while (< nbr (1+ rmail-total-messages))
558 (ti::mail-rmail-do-message-macro nbr nil
559 (setq rmail-current-message nbr)
562 (setq func (nth 0 elt)
564 stat (if (symbolp func)
568 (setq label (symbol-value label)))
571 (rmail-add-label stat))
572 ((and stat (stringp label))
573 (rmail-add-label label))
574 ((and stat (not (stringp label)))
575 (error "Label is not a string %s %s" label table))))
576 (run-hooks 'tinyrmail-:get-new-mail-hook))
579 ;;; ----------------------------------------------------------------------
581 (defun tinyrmail-rmail-get-new-mail-before-function ()
582 "Reset some values before getting mail."
584 tinyrmail-:rmail-info-list
587 rmail-current-message
590 rmail-summary-vector)))
592 ;;; ----------------------------------------------------------------------
594 (defadvice rmail-get-new-mail (before tinyrmail-hook act)
595 "Run hook 'tinyrmail-:rmail-get-new-mail-before-hook'."
596 (run-hooks 'tinyrmail-:rmail-get-new-mail-before-hook))
601 ;;; ----------------------------------------------------------------------
602 ;;; (ad-unadvise 'rmail-show-message)
604 (defadvice rmail-show-message (before tirm act)
606 If you change the `rmail-ignored-headers' it won't affect the current
607 messages unless you hit 't' to toggle headers. This advice reformats
608 message every time the message is shown."
609 ;; We do}t want expunge to call use, only direct
610 ;; show message command.
611 (when (interactive-p)
613 (rmail-maybe-set-message-counters)
614 (narrow-to-region (rmail-msgbeg (ad-get-arg 0)) (point-max))
615 (let ((buffer-read-only nil))
616 (goto-char (point-min))
618 ;; Convert 1 --> 0, otherwise format command barfs.
622 (let ((case-fold-search t))
623 (while (looking-at "Summary-Line:\\|Mail-From:")
625 (insert "*** EOOH ***\n")
627 (search-forward "\n*** EOOH ***\n")
629 (let ((temp (point)))
630 (and (search-forward "\n\n" nil t)
631 (delete-region temp (point))))
632 (goto-char (point-min))
633 (search-forward "\n*** EOOH ***\n")
634 (rmail-reformat-message (point-min) (point-max))))))
636 ;;; ----------------------------------------------------------------------
637 ;;; - Copy from rmailsum.el
638 ;;; - This would normally cause automatic update by mouse click, disable it
639 ;;; - I want to select message with RETURN or mouse-2. This way I can
640 ;;; move around the buffer and leave the message in RMAIL untouched.
642 (defadvice rmail-summary-enable (around tirm act)
644 Disable automatic update when mouse - 1 is pressed or cursor is moved.
645 You can browse the summary buffer more freely and keep the
646 selected message in RMAIL."
647 (use-local-map rmail-summary-mode-map)
648 ;; (add-hook 'post-command-hook 'rmail-summary-rmail-update)
649 (setq revert-buffer-function 'rmail-update-summary))
651 ;;; ----------------------------------------------------------------------
652 ;;; - Copy from rmailsum.el.
653 ;;; - I hate when I can't browse forward without getting
654 ;;; the Summary. Grr...
656 (defadvice rmail-summary-next-msg (around tirm act)
657 "Replace function. Disbale automatic showing of summary buffer."
659 (and (> number 0) (end-of-line))
660 (let ((count (if (< number 0) (- number) number))
661 (search (if (> number 0) 're-search-forward 're-search-backward))
662 (non-del-msg-found nil))
663 (while (and (> count 0) (setq non-del-msg-found
664 (or (funcall search "^....[^D]" nil t)
666 (setq count (1- count))))
668 ;;; this does automatic update, "p", "n" and mouse click
669 ;;; (display-buffer rmail-buffer)
673 ;;{{{ Fixing RMAIL messages
675 ;;; ----------------------------------------------------------------------
676 ;;; - When you run RMAIL over FCC'd file, and afterwards add more to that
677 ;;; FCC mail, the file may become corrupt so that RMAIL can't read all
679 ;;; - This little function, when header region is selected, converts
680 ;;; the headers to Rmail, so that summary can be used.
681 ;;; - I don't understand why my 'From ' field goes totally wrong...
684 (defun tinyrmail-fix-make-rmail-message-header (beg end)
685 "Fix RMAIL header in BEG END.
686 To use this function you must do this.
688 1. Be in RMAIL buffer
689 2. Change mode to text with \\[text-mode]
691 4. Select message's full headers
692 5. Call this function
694 After the call, the appropriate RMAIL message format for headers has been
697 (let* ( ;; START and END headers strings
698 (s-h (concat (char-to-string ?\037) "\f\n1,,\n")) ;start header
699 (e-h "*** EOOH ***\n")
703 (ti::keep-lower-order beg end)
704 ;; These lines are show in the real rmail message, rest are hidden.
706 (ti::buffer-grep-lines
707 "^To:\\|^From:\\|^date:\\|^Subject:" beg end))
708 (setq blk (buffer-substring beg end))
709 (kill-region beg end)
711 (insert s-h blk "\n" e-h)
712 (goto-char beg) (forward-line 2)
713 (if (null ;; Is this corrupted From line ?
714 (looking-at "From\\( [a-zA-Z]+ \\)\\([FSMTWS].*\\)"))
716 (setq from (buffer-substring (match-beginning 1) (match-end 1)))
717 (setq date (buffer-substring (match-beginning 2) (match-end 2)))
719 (setq line (concat "Date: " date "\n" "From:" from))
721 (if (null (re-search-forward (regexp-quote "***")))
722 (message "Not found [***]")
729 (re-search-forward "^Subject")
731 ;; If there is no babyl at all we may want to insert the RMAIL headers
733 (when (y-or-n-p "insert Rmail headers too?")
734 (if (null (re-search-forward (regexp-quote "***")))
735 (message "Can't find ***")
737 (insert (mapconcat 'concat rmail-lines "\n") "\n")))))
741 (add-hook 'tinyrmail-:get-new-mail-hook
742 'tinyrmail-delete-function)
745 (run-hooks 'tinyrmail-:load-hook)
747 ;;; tinyrmail.el ends here