emacs_el/tiny-tools/tiny/tinyrmail.el

   1 ;;; tinyrmail.el --- RMAIL add-ons, pgp, mime labels, Spam complaint.
   2
   3 ;; This file is not part of Emacs
   4
   5 ;;{{{ Id
   6
   7 ;; Copyright (C) 1996-2007 Jari Aalto
   8 ;; Keywords:     mail
   9 ;; Author:       Jari Aalto
  10 ;; Maintainer:   Jari Aalto
  11 ;;
  12 ;; To get information on this program, call M-x tinyrmail-version.
  13 ;; Look at the code with folding.el.
  14
  15 ;; COPYRIGHT NOTICE
  16 ;;
  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)
  20 ;; any later version.
  21 ;;
  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
  25 ;; for more details.
  26 ;;
  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.
  31 ;;
  32 ;; Visit <http://www.gnu.org/copyleft/gpl.html> for more information
  33
  34 ;;}}}
  35 ;;{{{ Install
  36
  37 ;; ....................................................... &t-install ...
  38 ;;
  39 ;;  ** NOTE: 1998-01 This file is no longer maintained. Plese see Gnus.
  40 ;;
  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
  43 ;;
  44 ;;      (require 'tinyrmail)
  45 ;;
  46 ;;  or prefer this; your .emacs loads up much quicker
  47 ;;
  48 ;;      (autoload 'tinyrmail-rmail-summary-by-labels-and "tinyrmail" "" t)
  49 ;;      (autoload 'tinyrmail-install                     "tinyrmail" "" t)
  50 ;;      (add-hook 'rmail-mode-hook                  'tinyrmail-install)
  51 ;;
  52 ;;  If you have any questions, use this function
  53 ;;
  54 ;;      M-x tinyrmail-submit-bug-report       ,send bug report
  55
  56 ;;}}}
  57
  58 ;;{{{ Documentation
  59
  60 ;; ..................................................... &t-commentary ...
  61 ;;; Commentary:
  62
  63 ;;  Preface, overview of features
  64 ;;
  65 ;;      1998-01: This file is no longer supported. Prefer to use Gnus
  66 ;;      instead. There is module *tinygnus.el* which provides additional
  67 ;;      utilies for Gnus.
  68 ;;
  69 ;;      o   Detect PGP, MIME mail and label incoming messages accordingly.
  70 ;;          User can add more checking functions and labels to incoming email
  71 ;;          messages
  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.
  79 ;;
  80 ;;  Description
  81 ;;
  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.
  86 ;;
  87 ;;      This means, that you can now classify your message, like this:
  88 ;;
  89 ;;          BASE
  90 ;;          SUBSET-IDENTIFIER
  91 ;;                MINOR-IDENTIFIER
  92 ;;                   NOTE-IDENTIFIER
  93 ;;
  94 ;;       Eg. For PGP mails I have
  95 ;;
  96 ;;          {pgp}
  97 ;;          {pgp,v}         -- verified signature
  98 ;;          {pgp,u}         -- not verified
  99 ;;          {pgp,v,e}       -- verified and encrypted
 100 ;;
 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)
 106 ;;
 107 ;;  Automatic deletion of incoming mail
 108 ;;
 109 ;;      There is default function to mark messages as deleted according
 110 ;;      to regexp. Please configure this variable to suit your needs:
 111 ;;
 112 ;;          tinyrmail-:delete-regexp
 113 ;;
 114 ;;      If you want more personal control whether the mail
 115 ;;      should be deleted or not, please remove the default delete function
 116 ;;      and add your own:
 117 ;;
 118 ;;          (add-hook 'tinyrmail-:load-hook 'my-tinyrmail-:load-hook)
 119 ;;
 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))
 126 ;;
 127 ;;
 128 ;;          (defun my-rmail-delete-function ()
 129 ;;           ...)
 130 ;;
 131 ;;  New commands in RMAIL
 132 ;;
 133 ;;      Refer to function tinyrmail-define-default-keys for exact setup.
 134 ;;      Currently the only new command added is
 135 ;;
 136 ;;          "L" tinyrmail-rmail-summary-by-labels-and
 137 ;;
 138 ;;  Fixing RMAIL format
 139 ;;
 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
 144 ;;
 145 ;;          From
 146 ;;
 147 ;;      Field at the beginning of message. I have seen even some garbage
 148 ;;      Prepended to field so that it looked like
 149 ;;
 150 ;;          m?From
 151 ;;
 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.
 156 ;;
 157 ;;      Now starts the fixing part to make rmail happy again:
 158 ;;
 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)
 166 ;;
 167 ;;      After you have converted all headers to rmail format, you can
 168 ;;      start rmail again with command
 169 ;;
 170 ;;          M-x rmail-mode
 171 ;;
 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
 177 ;;
 178 ;;          ~/.newmail-USERNAME
 179 ;;
 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.
 183 ;;
 184 ;;  Standard Rmail distribution changes
 185 ;;
 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.
 189 ;;      To disable forms:
 190 ;;
 191 ;;          (setq tinyrmail-:load-hook '(tinyrmail-install))
 192 ;;
 193 ;;      To disable advices, you do
 194 ;;
 195 ;;          (setq tinyrmail-:load-hook '(tinyrmail-install my-tinyrmail-install))
 196 ;;
 197 ;;          (defun my-tinyrmail-install ()
 198 ;;            (ti::advice-control
 199 ;;              '(rmail-show-message
 200 ;;                rmail-summary-enable
 201 ;;                rmail-summary-next-msg
 202 ;;                )
 203 ;;               "^tinyrmail"
 204 ;;               'disable
 205 ;;               ))
 206 ;;
 207 ;;
 208 ;;      `tinyrmail-:forms-rmail'
 209 ;;
 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
 219 ;;          quit Emacs too.
 220 ;;
 221 ;;      Advices:
 222 ;;
 223 ;;      *rmail-show-message* active
 224 ;;
 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'.
 232 ;;
 233 ;;      *rmail-summary-enable* active
 234 ;;
 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.
 239 ;;
 240 ;;      *rmail-summary-next-msg* active
 241 ;;
 242 ;;      Same as above.
 243 ;;
 244
 245 ;;}}}
 246
 247 ;;; Change Log:
 248
 249 ;;; Code:
 250
 251 ;;{{{ setup: libraries
 252
 253 (require  'rmail)                       ;Uses macros from there
 254 (require  'tinylibm)
 255
 256 (eval-and-compile
 257   (autoload 'rmail-new-summary "rmailsum"))
 258
 259 (eval-when-compile (ti::package-use-dynamic-compilation))
 260
 261 (ti::package-defgroup-tiny TinyRmail tinyrmail-: mail
 262   "Additional features to RMAIL.
 263 Overview of features
 264
 265         o   Detect PGP, MIME mail and label incoming messages accordingly.
 266             User can add more checking functions and labels to incoming email
 267             messages
 268         o   New label summary cmd with AND, e.g. {pgp,v} for verified pgp mails.")
 269
 270 ;;}}}
 271 ;;{{{ setup: hooks
 272
 273 (defcustom tinyrmail-:load-hook '(tinyrmail-install tinyrmail-install-forms)
 274   "*Hook that is run when package is loaded."
 275   :type  'hook
 276   :group 'TinyRmail)
 277
 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."
 283   :type  'hook
 284   :group 'TinyRmail)
 285
 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."
 291   :type  'hook
 292   :group 'TinyRmail)
 293
 294 ;;}}}
 295 ;;{{{ setup: public, user configurable
 296
 297 (defcustom tinyrmail-:delete-regexp
 298   (concat
 299    "make.*money"
 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")
 306   :group 'TinyRmail)
 307
 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.
 312 Format is
 313
 314   '((CHECK-FUNCTION STRING-OR-SYMBOL) (F S) ..).
 315
 316 The STRING-OR-SYMBOL may be either \"string\" or variable name
 317 'lisp-var, where its `symbol-value' is used.
 318
 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.
 322
 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."
 326   :type '(repeat
 327           (list
 328            (function :tag "Check function")
 329            (choice
 330             :inline t
 331             (string :tag "String Label")
 332             (symbol :tag "Var Symbol"))))
 333   :group 'TinyRmail)
 334
 335 ;;}}}
 336 ;;{{{ setup: private
 337
 338 (defvar tinyrmail-:rmail-info-list  nil
 339   "Values of saved message counters before we get new mail.")
 340
 341 (defconst tinyrmail-:forms-rmail
 342   '(progn
 343      (when (boundp 'rmail-summary-mode-map)
 344        (cond
 345         ((ti::emacs-p)
 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))
 352         (t
 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)
 363         (not 'temp-buffers)
 364         (not 'exclude)
 365         (progn
 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.
 369        ;;
 370        (define-key rmail-summary-mode-map "q" 'ignore))
 371      (when (boundp 'rmail-mode-map)
 372        (define-key rmail-mode-map "q"
 373          '(lambda ()
 374             "Confirm quit."
 375             (interactive)
 376             (if (y-or-n-p "Really quit RMAIL ")
 377                 (rmail-quit))))))
 378   "Additional forms to `after-load-alist'.
 379 Set this variable to '(progn) if you want to disable these features.")
 380
 381 ;;}}}
 382 ;;{{{ version
 383
 384 ;;;###autoload (autoload 'tinyrmail-version "tinyrmail" "Display commentary." t)
 385
 386 (eval-and-compile
 387   (ti::macrof-version-bug-report
 388    "tinyrmail.el"
 389    "tinyrmail"
 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
 394      tinyrmail-:load-hook
 395      tinyrmail-:rmail-get-new-mail-before-hook
 396      tinyrmail-:get-new-mail-hook
 397      tinyrmail-:delete-regexp
 398      tinyrmail-:label-table)))
 399
 400 ;;}}}
 401 ;;{{{ Installation
 402
 403 ;;; ----------------------------------------------------------------------
 404 ;;;
 405 ;;;###autoload (autoload 'tinyrmail-install-files "tinyrmail" t t)
 406 (ti::macrof-install-pgp-tar tinyrmail-install-files "tinyrmail.el")
 407
 408 ;;; ----------------------------------------------------------------------
 409 ;;;
 410 (defun tinyrmail-install-forms  ()
 411   "Some other things to do to get all installed.
 412 See source code for
 413 better explanation."
 414   (interactive)
 415   (when (boundp 'rmail-summary-mode-map)
 416     (eval tinyrmail-:forms-rmail))      ;run it immediately
 417   (cond
 418    ((not (fboundp 'eval-after-load))
 419     (load "rmailsum")
 420     (load "rmail")
 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))))
 426
 427 ;;; ----------------------------------------------------------------------
 428 ;;; - If more commnds are added, I make this a separate minor mode...
 429 ;;;
 430 (defun tinyrmail-define-default-keys  ()
 431   "Define keys to various maps."
 432   (interactive)
 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
 437   ;;  compiler.
 438   (when (boundp 'rmail-summary-mode-map)
 439     (define-key
 440       (symbol-value 'rmail-summary-mode-map)
 441       "L"
 442       'tinyrmail-rmail-summary-by-labels-and)))
 443
 444 ;;; ----------------------------------------------------------------------
 445 ;;;
 446 (defun tinyrmail-install-advices  (&optional remove verb)
 447   "Install advices. Optionally REMOVE advices. VERB."
 448   (interactive "P")
 449   (ti::advice-control
 450    '(rmail-get-new-mail)
 451    "^tinyrmail-"
 452    remove
 453    (or verb
 454        (interactive-p))))
 455
 456 ;;; ----------------------------------------------------------------------
 457 ;;;
 458 (defun tinyrmail-install (&optional remove)
 459   "Install package hooks. Optionally REMOVE installation.
 460 Can't restore changes to keymaps."
 461   (interactive "P")
 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)
 467     ;; New commands
 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)))
 473
 474 ;;}}}
 475 ;;{{{ rmail, labels
 476
 477 ;;; ----------------------------------------------------------------------
 478 ;;; see rmailsum.el
 479 ;;;
 480 ;;;###autoload
 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
 494                      ;;
 495                      (split-string labels "[ ,]+")))
 496
 497 ;;; ----------------------------------------------------------------------
 498 ;;;
 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
 502          (i     0))
 503     (save-excursion
 504       (save-restriction
 505         (widen)
 506         (goto-char (rmail-msgbeg msg))
 507         (forward-char 3)
 508         (dolist (elt labels)
 509           ;; May look like this:
 510           ;;
 511           ;;    1,, pgp, v,
 512           (if (looking-at (concat ".* " elt ","))
 513               (incf  i)))))
 514     ;;  Must have as many hits as labels passed to function
 515     (eq (length copy) i)))
 516
 517 ;;}}}
 518 ;;{{{ rmail, new message
 519
 520 ;;; ----------------------------------------------------------------------
 521 ;;;
 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'."
 525   (ti::pmin)
 526   (if (and (stringp tinyrmail-:delete-regexp)
 527            (re-search-forward tinyrmail-:delete-regexp nil t))
 528       (rmail-delete-message)))
 529
 530 ;;; ----------------------------------------------------------------------
 531 ;;;
 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)))
 542
 543 ;;; ----------------------------------------------------------------------
 544 ;;;
 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)
 549          nbr
 550          list
 551          func
 552          label
 553          stat)
 554     ;; Is there new mail, maybe some of them are not read yet?
 555     (setq nbr (tinyrmail-rmail-new-message-ptr))
 556     (when nbr
 557       (while (< nbr (1+ rmail-total-messages))
 558         (ti::mail-rmail-do-message-macro nbr nil
 559                                          (setq rmail-current-message nbr)
 560                                          (setq list table)
 561                                          (dolist (elt list)
 562                                            (setq func  (nth 0 elt)
 563                                                  label (nth 1 elt)
 564                                                  stat  (if (symbolp func)
 565                                                            (funcall func)
 566                                                          (eval func)))
 567                                            (if (symbolp label)
 568                                                (setq label (symbol-value label)))
 569                                            (cond
 570                                             ((stringp stat)
 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))
 577         (incf  nbr)))))
 578
 579 ;;; ----------------------------------------------------------------------
 580 ;;;
 581 (defun tinyrmail-rmail-get-new-mail-before-function  ()
 582   "Reset some values before getting mail."
 583   (setq
 584    tinyrmail-:rmail-info-list
 585    (list
 586     rmail-total-messages
 587     rmail-current-message
 588     rmail-message-vector
 589     rmail-deleted-vector
 590     rmail-summary-vector)))
 591
 592 ;;; ----------------------------------------------------------------------
 593 ;;;
 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))
 597
 598 ;;}}}
 599 ;;{{{ Advice
 600
 601 ;;; ----------------------------------------------------------------------
 602 ;;; (ad-unadvise 'rmail-show-message)
 603 ;;;
 604 (defadvice rmail-show-message  (before tirm act)
 605   "Reformat message.
 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)
 612     (ti::widen-safe
 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))
 617         (forward-line 1)
 618         ;;  Convert 1 --> 0, otherwise format command barfs.
 619         (delete-char 1)
 620         (insert "0")
 621         (forward-line 1)
 622         (let ((case-fold-search t))
 623           (while (looking-at "Summary-Line:\\|Mail-From:")
 624             (forward-line 1)))
 625         (insert "*** EOOH ***\n")
 626         (forward-char -1)
 627         (search-forward "\n*** EOOH ***\n")
 628         (forward-line -1)
 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))))))
 635
 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.
 641 ;;;
 642 (defadvice rmail-summary-enable (around tirm act)
 643   "Replace function.
 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))
 650
 651 ;;; ----------------------------------------------------------------------
 652 ;;; - Copy from rmailsum.el.
 653 ;;; - I hate when I can't browse forward without getting
 654 ;;;   the Summary. Grr...
 655 ;;;
 656 (defadvice rmail-summary-next-msg (around tirm act)
 657   "Replace function. Disbale automatic showing of summary buffer."
 658   (forward-line 0)
 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)
 665                                       non-del-msg-found)))
 666       (setq count (1- count))))
 667   (beginning-of-line)
 668 ;;; this does automatic update, "p", "n" and mouse click
 669 ;;;  (display-buffer rmail-buffer)
 670   nil)
 671
 672 ;;}}}
 673 ;;{{{ Fixing RMAIL messages
 674
 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
 678 ;;;   messages in it.
 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...
 682 ;;;
 683 ;;;
 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.
 687
 688 1. Be in RMAIL buffer
 689 2. Change mode to text with \\[text-mode]
 690 3. run \\[widen]
 691 4. Select message's full headers
 692 5. Call this function
 693
 694 After the call, the appropriate RMAIL message format for headers has been
 695 created."
 696   (interactive "r")
 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")
 700          blk line
 701          from date
 702          rmail-lines)
 703     (ti::keep-lower-order beg end)
 704     ;;  These lines are show in the real rmail message, rest are hidden.
 705     (setq rmail-lines
 706           (ti::buffer-grep-lines
 707            "^To:\\|^From:\\|^date:\\|^Subject:" beg end))
 708     (setq blk (buffer-substring beg end))
 709     (kill-region beg end)
 710     (goto-char beg)
 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].*\\)"))
 715         nil
 716       (setq from (buffer-substring (match-beginning 1) (match-end 1)))
 717       (setq date (buffer-substring (match-beginning 2) (match-end 2)))
 718       (kill-line)
 719       (setq line (concat "Date: " date "\n" "From:" from))
 720       (insert line)
 721       (if (null (re-search-forward (regexp-quote "***")))
 722           (message "Not found [***]")
 723         (forward-line 1)
 724         (setq beg (point))
 725         (insert blk)
 726         (goto-char beg)
 727         (kill-line)
 728         (insert line)
 729         (re-search-forward "^Subject")
 730         (forward-line)))
 731     ;; If there is no babyl at all we may want to insert the RMAIL headers
 732     ;;
 733     (when (y-or-n-p "insert Rmail headers too?")
 734       (if (null (re-search-forward (regexp-quote "***")))
 735           (message "Can't find ***")
 736         (forward-line 1)
 737         (insert (mapconcat 'concat rmail-lines "\n") "\n")))))
 738
 739 ;;}}}
 740
 741 (add-hook 'tinyrmail-:get-new-mail-hook
 742           'tinyrmail-delete-function)
 743
 744 (provide   'tinyrmail)
 745 (run-hooks 'tinyrmail-:load-hook)
 746
 747 ;;; tinyrmail.el ends here