1 ;;; tinymailbox.el --- Berkeley style aka std. mailbox browsing minor mode
3 ;; This file is not part of Emacs
7 ;; Copyright (C) 1997-2007 Jari Aalto
10 ;; Maintainer: Jari Aalto
12 ;; To get information on this program, call M-x tinymailbox-version.
13 ;; Look at the code with folding.el.
15 ;; This program is free software; you can redistribute it and/or modify it
16 ;; under the terms of the GNU General Public License as published by the Free
17 ;; Software Foundation; either version 2 of the License, or (at your option)
20 ;; This program is distributed in the hope that it will be useful, but
21 ;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
22 ;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
25 ;; You should have received a copy of the GNU General Public License
26 ;; along with program; see the file COPYING. If not, write to the
27 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
28 ;; Boston, MA 02110-1301, USA.
30 ;; Visit <http://www.gnu.org/copyleft/gpl.html> for more information
35 ;; ....................................................... &t-install ...
36 ;; Put this file on your Emacs-Lisp load path, add following into your
37 ;; ~/.emacs startup file. Code can be extracted with function
38 ;; tinylib.el/ti::package-rip-magic
40 ;; (add-hook 'tinymailbox-:load-hook 'tinymailbox-install)
41 ;; (require 'tinymailbox)
43 ;; Or you can also use the preferred way: autoload
45 ;; (add-hook 'tinymailbox-:load-hook 'tinymailbox-install)
46 ;; (autoload 'tinymailbox-mode "tinymailbox "" t)
47 ;; (autoload 'turn-on-tinymailbox-mode "tinymailbox "" t)
48 ;; (autoload 'turn-off-tinymailbox-mode "tinymailbox "" t)
50 ;; You can toggle the mode with `M-x' `tinymailbox-mode'. The default
51 ;; mailbox type files are liested in `tinymailbox-:auto-mode-alist'.
52 ;; To add more mailbox files for the mode, use code like:
55 ;; (pushnew '("\\.spool\\'" . turn-on-tinymailbox-mode-maybe)
58 ;; (pushnew '("\\.mbo?x\\'" . turn-on-tinymailbox-mode-maybe)
62 ;; If you have any questions, use this function to contact author
64 ;; M-x tinymailbox-submit-bug-report
69 ;; ..................................................... &t-commentary ...
74 ;; It is possible to use Procmail <http://www.procmail.org/> to
75 ;; manage growing incoming mail. But sometimes your recipes go
76 ;; wrong and mail ends up folders that you dind't intend to.
77 ;; People usually direct UBE, UCE and Spam mail to different
78 ;; folders, but sometimes procmail filter just guesses wrong and
79 ;; it sends perfetly valid mail into one of these reject folders.
80 ;; It is good to check the Spam mailboxes manually for valid mail
81 ;; and then extract it out of them. Not very nice job to do. At
82 ;; the the time Gnus was not available for managing multiple
83 ;; forlders so I decided to pull out some old code and make it a
86 ;; Overview of features
88 ;; o Browse standard unix mailbox .mbox .mbx .spool
89 ;; o Kill, copy messages from mailbox. Copy message bodies.
90 ;; o Highlighting and defcustom supported.
91 ;; o Hide or show headers during mailbox browsing.
92 ;; o Simple summaries can be done with `occur' command. Eg. to browse
93 ;; messages based on `From' or `Subject' Headers.
95 ;; Showing and hiding headers
97 ;; When you browse a mail folder, it has lot of attached headers,
98 ;; which don't interest you at all when you want to look at the
99 ;; messages itself. for example, here is one typical header from
102 ;; From nobody Sun Sep 28 20:57:48 1997
104 ;; Subject: Re: bandwidth (was: [RePol] check this issue)
105 ;; References: <tbd8lwmfid.fsf@totally-fudged-out-message-id>
106 ;; From: Foo bar <judgeDredd@marylyn.com>
107 ;; Date: 28 Sep 1997 20:57:47 +0300
108 ;; In-Reply-To: Jeff's message of "Tue, 23 Sep 1997 01:35:26 -0400"
109 ;; Message-ID: <tbiuvlmick.fsf@marylyn.com>
110 ;; X-Mailer: Quassia Gnus v0.11/Emacs 19.34
112 ;; Xref: marylyn.com junk-test:4
113 ;; X-Gnus-Article-Number: 4 Sun Sep 28 20:57:48 1997
115 ;; When you go from this message with `tinymailbox-forward', the headers
116 ;; that you're interested in are only shown according to
117 ;; `tinymailbox-:header-show-regexp'. The messages headers are collapsed
118 ;; as you move around the messages. This approach was chosen, so that
119 ;; parsing a big message file (Gnus nnfolder backend) wouldn't put you
120 ;; on hold while the headers were collapsed. Now the headers are
121 ;; handled while you browse forward and backward. The above headers
122 ;; lookes like this after
126 ;; Subject: Re: bandwidth (was: [RePol] check this issue)
127 ;; From: Foo bar <foo@example.com>
128 ;; Date: 28 Sep 1997 20:57:47 +0300
129 ;; X-Mailer: Quassia Gnus v0.11/Emacs 19.34
130 ;; X-Gnus-Article-Number: 4 Sun Sep 28 20:57:48 1997
132 ;; By default all the `X-' headers are shown, so you may want to make
133 ;; the `tinymailbox-:header-show-regexp' a bit more restrictive if
134 ;; messages contain too many X-headers. You can toggle this message
135 ;; hiding feature with
137 ;; C-c ' C-q or tinymailbox-header-hide-mode
139 ;; Copying or deleting messages
141 ;; When you browse the mailbox, you can perform copy or delete on
142 ;; the current message with following commands.
144 ;; C-c ' RET tinymailbox-copy
145 ;; C-c ' SPC tinymailbox-copy-body
146 ;; C-c ' d tinymailbox-delete
148 ;; Moving between the messages
150 ;; There are couple of movement commands that let you jump from
151 ;; one message to another. See also variable `tinymailbox-:move-header-regexp'
153 ;; C-p tinymailbox-forward-body or Ctrl-home
154 ;; C-n tinymailbox-backward-body or Ctrl-end
155 ;; home tinymailbox-forward (see tinymailbox-:move-header-regexp)
156 ;; end tinymailbox-backward
167 ;; (require 'sendmail)
169 (eval-when-compile (ti::package-use-dynamic-compilation))
172 (defvar mail-yank-prefix) ;; Byte compiler silencer
173 (autoload 'mail-fetch-field "mail-utils")
174 (autoload 'mail-position-on-field "mail-utils")
175 (autoload 'string-rectangle "rect" "" t))
177 (ti::package-defgroup-tiny TinyMailbox tinymailbox-: tools
178 "Mailbox management minor mode.
181 o Browse standard unix mailbox .mbox .mbx .spool
182 o Kill, copy messages from mailbox. Copy message bodies.
183 o Highlighting and defcustom supported.
184 o Hide or show headers during mailbox browsing.
185 o Simple summaries can be done with `occur' command. Eg. to browse
186 messages based on `From' or `Subject' Headers.")
189 ;;{{{ setup: variables
191 ;;; ......................................................... &v-hooks ...
193 (defcustom tinymailbox-:load-hook nil
194 "*Hook run when package has been loaded."
198 (defcustom tinymailbox-:mail-setup-hook nil
199 "*Hook run when mail has been composed.
200 The point is at the beginning of message."
204 ;;; ......................................................... &private ...
206 (defvar tinymailbox-:last-file nil
207 "Last file used by `tinymailbox-message-to-folder'.")
209 (defvar tinymailbox:-header-begin-regexp
210 "\n\n[A-Z][a-z]: +\\|^From "
211 "Regexp of beginning of message headers")
213 ;;; ........................................................ &v-public ...
215 (defcustom tinymailbox-:font-lock-keywords
216 '(("From:[ \t]*\\(.*\\)"
217 (1 font-lock-function-name-face))
219 ("Reply-To:[ \t]*\\(.*\\)"
220 (1 font-lock-function-name-face))
222 ("Subject:[ \t]*\\(.*\\)"
223 (1 font-lock-keyword-face))
225 ("^\\(X-[A-Za-z0-9-]+\\|Date\\):[ \t]*\\(.*\\)"
226 (1 font-lock-reference-face)))
227 "*Font lock keywords."
231 (defcustom tinymailbox-:auto-mode-alist
232 '(("\\.mbo?x\\'" . turn-on-tinymailbox-mode-maybe)
233 ;; Gnus spool file: Incoming
234 ("Incoming" . turn-on-tinymailbox-mode-maybe)
235 ;; Gnus `nnml' backend where procmail should deliver output to
236 ;; xxx..xxxx.spool, like mail.private.spool, junk.spam.spool,
238 ("\\.spool\\'" . turn-on-tinymailbox-mode-maybe))
239 "Items to add to `auto-mode-alist' to turn mode on when file is loaded."
242 (string :tag "File Regexp")
243 (const 'tinymailbox-mode)))
246 (defcustom tinymailbox-:move-header-regexp "^Subject:"
247 "Regexp that is use in movement commands. See `tinymailbox-forward'."
251 (defcustom tinymailbox-:header-show-regexp
252 "^Subject:\\|^To:\\|^From:\\|^Newsgroups:\\|^X-\\|^Date:"
253 "Regexp to show the interesting headers. Others will be hidden."
257 (defcustom tinymailbox-:header-hide-mode t
258 "If non-nil then uninteresting headers are hidden while you move."
262 ;;; .......................................................... &v-menu ...
264 (defcustom tinymailbox-:menu-use-flag t
265 "*Non-nil means to use echo-area menu."
269 (defvar tinymailbox-:menu-main
272 "%sTinyMbx: hdr)+-C-q copy)RETSPC m)ail oO)ccur f)ld F)ile ?H) d)el x)mode off"
273 (if current-prefix-arg
274 (format "%s " (prin1-to-string current-prefix-arg)) "" ))
276 (?+ . ( (call-interactively 'tinymailbox-header-show)))
277 (?- . ( (call-interactively 'tinymailbox-header-hide)))
278 (?\C-q . ( (call-interactively 'tinymailbox-header-hide-mode)))
279 (?d . ( (call-interactively 'tinymailbox-delete)))
280 (?\C-m . ( (call-interactively 'tinymailbox-copy)))
281 (?\ . ( (call-interactively 'tinymailbox-copy-body)))
282 (?m . ( (call-interactively 'tinymailbox-mail-send-at-point)))
283 (?o . ( (call-interactively 'tinymailbox-occur)))
284 (?O . ( (call-interactively 'tinymailbox-occur-subject)))
285 (?f . ( (call-interactively 'tinymailbox-message-to-folder)))
286 (?F . ( (call-interactively 'tinymailbox-message-write-file)))
287 (?? . 'tinymailbox-:menu-help)
288 (?H . 'tinymailbox-:menu-help)
289 (?x . ( (call-interactively 'turn-off-tinymailbox-help)))))
290 "*TinyMailbox echo menu.
296 C-q Toggle header mode
306 m Send mail with current message
307 f Append message to a folder
308 F Write message to a file
312 o Run M-x occur on all lines
313 O Run M-x occur for Subject matches only.
318 ;;;###autoload (autoload 'tinymailbox-version "tinymailbox" "Display commentary" t)
320 (ti::macrof-version-bug-report
323 tinymailbox-:version-id
324 "$Id: tinymailbox.el,v 2.79 2007/05/06 23:15:20 jaalto Exp $"
325 '(tinymailbox-:version-id
326 tinymailbox-:load-hook
327 tinymailbox-:last-file
328 tinymailbox-:font-lock-keywords
329 tinymailbox-:auto-mode-alist
330 tinymailbox-:move-header-regexp
331 tinymailbox-:header-show-regexp
332 tinymailbox-:header-hide-mode
333 tinymailbox-:menu-use-flag
334 tinymailbox-:menu-main)
335 '(tinymailbox-:debug-buffer)))
340 ;;;###autoload (autoload 'tinymailbox-install-mode "tinymailbox" "" t)
341 ;;;###autoload (autoload 'tinymailbox-mode "tinymailbox" "" t)
342 ;;;###autoload (autoload 'turn-on-tinymailbox-mode "tinymailbox" "" t)
343 ;;;###autoload (autoload 'turn-off-tinymailbox-mode "tinymailbox" "" t)
344 ;;;###autoload (autoload 'tinymailbox-commentary "tinymailbox" "" t)
347 (ti::macrof-minor-mode-wizard
348 "tinymailbox-" " Mbx" "\C-c'" "Mbx" 'TinyMailbox "tinymailbox-:"
350 "Unix mailbox minor mode.
352 You use this minor mode to browse your .mbx and .mbox files or any file
353 hich is stored in standard unix mailbox format (like news articles). The
354 file format is as follows. notice that there is no mistake, the first
355 'From ' field marks the message biginning and there is no colon.
357 From Foo Wee Gee <Gee@this.is>
358 Subject: Swiss Yodddla-laddli-duu
359 Newsgroups: nothing.interesting
363 From Foo Wee Gee <Gee@this.is>
364 Subject: Swiss Yodddla-laddli-duu
365 Newsgroups: nothing.interesting
371 Prefix key to access the minor mode is defined in `tinymailbox-:mode-prefix-key'
373 \\{tinymailbox-:mode-map}"
377 (progn ;Some mode specific things? No?
378 (when (and tinymailbox-mode
379 (not (get 'tinymailbox-install 'install-done)))
380 ;; User called us directly and forgot tu run install. Do it now
381 (tinymailbox-install))
382 (tinymailbox-font-lock)
383 ;; When mode is turned off, we must kill the text properties we used
384 (unless tinymailbox-mode
386 (ti::text-property-search-and-modify '(owner timbx) nil))))
390 tinymailbox-:mode-easymenu-name
392 ["Message forward" tinymailbox-forward t]
393 ["Message backward" tinymailbox-backward t]
394 ["Body forward" tinymailbox-forward-boby t]
395 ["Body backward" tinymailbox-backward-body t]
397 ["Header Hide" tinymailbox-header-hide t]
398 ["Header Show" tinymailbox-header-show t]
399 ["Header show/hide mode" tinymailbox-header-hide-mode t]
401 ["Copy message" tinymailbox-copy t]
402 ["Copy message body" tinymailbox-copy-body t]
403 ["Delete message" tinymailbox-delete t]
405 ["Append to file" tinymailbox-message-to-folder t]
406 ["Write to file" tinymailbox-message-write-file t]
407 ["Send email at point" tinymailbox-mail-send-at-point t]
409 ["Make Summary (occur)" tinymailbox-occur t]
410 ["Make Summary (occur subject)" tinymailbox-occur-subject t]
412 ["Keyboard menu" tinymailbox-menu-main t]
413 ["Package version" tinymailbox-version t]
414 ["Package commentary" tinymailbox-commentary t]
415 ["Mode help" tinymailbox-mode-help t]
416 ["Mode off" turn-off-tinymailbox-mode t])
419 (tinymailbox-:menu-use-flag
420 ;; Using menu to remeber commands is easier if you don't use
422 (define-key root-map [(home)] 'tinymailbox-backward)
423 (define-key root-map [(end)] 'tinymailbox-forward)
424 (define-key root-map "\C-p" 'tinymailbox-backward-body)
425 (define-key root-map "\C-n" 'tinymailbox-forward-body)
426 (define-key root-map [(control home)] 'tinymailbox-backward-body)
427 (define-key root-map [(control end)] 'tinymailbox-forward-body)
428 (define-key root-map p 'tinymailbox-menu-main))
430 (define-key root-map [(home)] 'tinymailbox-backward)
431 (define-key root-map [(end)] 'tinymailbox-forward)
432 (define-key root-map "\C-p" 'tinymailbox-backward-body)
433 (define-key root-map "\C-n" 'tinymailbox-forward-body)
434 (define-key root-map [(control home)] 'tinymailbox-backward-body)
435 (define-key root-map [(control end)] 'tinymailbox-forward-body)
436 (define-key map "+" 'tinymailbox-header-show)
437 (define-key map "-" 'tinymailbox-header-hide)
438 (define-key map "\C-q" 'tinymailbox-header-hide-mode)
439 (define-key map "d" 'tinymailbox-delete)
440 (define-key map "\C-m" 'tinymailbox-copy)
441 (define-key map " " 'tinymailbox-copy-body)
442 (define-key map "m" 'tinymailbox-mail-send-at-point)
443 (define-key map "o" 'tinymailbox-occur)
444 (define-key map "O" 'tinymailbox-occur-subject)
445 (define-key map "f" 'tinymailbox-message-to-folder)
446 (define-key map "F" 'tinymailbox-message-write-file)
447 (define-key map "?" 'tinymailbox-help)
448 (define-key map "Hm" 'tinymailbox-mode-help)
449 (define-key map "Hc" 'tinymailbox-commentary)
450 (define-key map "Hv" 'tinymailbox-version)
451 (define-key map "x" 'turn-off-tinymailbox-mode)
452 (message "TinyMailbox: Use home/end to move between messages."))))))
454 ;;; ----------------------------------------------------------------------
456 (defun tinymailbox-menu-main (&optional arg)
457 "Show echo area menu and pass ARG to `ti::menu-menu'."
459 (ti::menu-menu 'tinymailbox-:menu-main arg))
464 ;;; ----------------------------------------------------------------------
466 (defun tinymailbox-mode-candidate-p ()
467 "Return non-nil if buffer is candidate for `tinymailbox-mode'."
468 (and (not (or (memq major-mode
476 ;; Do not activate on
480 ;; .procmailrc (dot files in general)
482 "^\\.\\|\\.\\(log\\|tmp\\)$\\|VM\\|RMAIL"
483 (or (buffer-name) ""))))
484 (ti::mail-mailbox-p)))
486 ;;; ----------------------------------------------------------------------
488 (defun turn-on-tinymailbox-mode-maybe ()
489 "Turn on `tinymailbox-mode' if buffer looks like a Berkeley mailbox.
490 Ignore big mailboxes."
491 (when (and (tinymailbox-mode-candidate-p)
492 ;; Font-locking is too slow for big mailboxes
493 (< (buffer-size) (* 2 1000 1000)))
494 (turn-on-tinymailbox-mode)))
496 ;;; ----------------------------------------------------------------------
499 (defun tinymailbox-install (&optional uninstall verb)
500 "Install mode, or optionally UNINSTALL and print messages with VERB."
503 ;; Signal that we were called. This is checked inside mode wizard
504 (put 'tinymailbox-install 'install-done t))
505 (ti::assoc-replace-maybe-add 'auto-mode-alist
506 tinymailbox-:auto-mode-alist
508 (ti::add-hooks 'find-file-hooks
509 'turn-on-tinymailbox-mode-maybe
513 (message "TinyMailbox %s"
518 ;;; ----------------------------------------------------------------------
521 (defun tinymailbox-uninstall ()
523 (tinymailbox-install 'uninstall (interactive-p)))
525 ;;; ----------------------------------------------------------------------
527 (defun tinymailbox-font-lock ()
528 "Add/remove font lock support if `font-lock-mode' exists."
530 (let* ((sym 'font-lock-keywords)
532 (when (and (boundp sym)
533 (ti::colors-supported-p))
536 (ti::string-syntax-kill-double-quote)
537 (make-variable-buffer-local 'tinymailbox-:font-lock-keywords)
538 (unless (get 'tinymailbox-:font-lock-keywords 'original)
539 (put 'tinymailbox-:font-lock-keywords
542 (set sym tinymailbox-:font-lock-keywords)
547 (get 'tinymailbox-:font-lock-keywords 'original)))
549 (when (and (boundp 'font-lock-mode)
550 (symbol-value 'font-lock-mode))
551 ;; fontify approx. 50 lines or until point-max
553 (font-lock-fontify-region
555 (min (+ (point) (* 80 50)) (point-max))))))))
560 ;;; ----------------------------------------------------------------------
562 (defsubst tinymailbox-message-move-beginning ()
563 "Move to message beginning."
564 (re-search-backward tinymailbox:-header-begin-regexp nil t))
566 ;;; ----------------------------------------------------------------------
568 (put 'tinymailbox-message-macro 'lisp-indent-function 0)
569 (put 'tinymailbox-message-macro 'edebug-form-spec '(body))
570 (defmacro tinymailbox-message-macro (&rest body)
571 "Do BODY on message. You can refer to `beg' and `end' for message region."
573 (let* ((opoint (point))
576 ;; Just to make byteCompiler happy
577 (if (null opoint) (setq opoint nil))
578 (if beg (setq beg t))
579 (if end (setq end t))
580 (tinymailbox-begin 'backward)
585 ;; Last line of previous message is here....
587 ;; From asdasdasdadas
590 ;;; (if (looking-at "From ")
591 ;;; (backward-line 1)) ;Fix position a bit
596 ;;; ----------------------------------------------------------------------
598 (put 'tinymailbox-header-macro 'lisp-indent-function 0)
599 (defmacro tinymailbox-header-macro (&rest body)
600 "Do BODY on message. You can refer to `beg' and `end' for message region."
604 ;; Just to make byteCompiler happy
609 (tinymailbox-begin 'backward) (setq beg (point))
610 (re-search-forward "^[ \t]*$")
615 ;;; ----------------------------------------------------------------------
617 (put 'tinymailbox-paragraph-macro 'lisp-indent-function 0)
618 (defmacro tinymailbox-paragraph-macro (&rest body)
619 "Set paragraph values locally while executing BODY."
621 (let* ((sentence-end "[.?!]*[ \n]+")
622 (paragraph-start "^[ \t]*$")
623 (paragraph-separate paragraph-start))
629 ;;; ----------------------------------------------------------------------
631 (defun tinymailbox-header-p ()
632 "Check if point is inside header."
636 (looking-at "^[A-Z][^:]+: ")))
638 ;;; ----------------------------------------------------------------------
640 (defun tinymailbox-overlay (act &optional beg end)
641 "If ACT is 'hide, hide overlay, otherwise highlight BEG END."
643 (if (boundp 'mouse-drag-overlay) ;Emacs, use this by default
645 'primary-selection-extent)))
648 (ti::compat-overlay-move ov 1 1)
651 (ti::compat-overlay-move ov beg end)
652 (setq ov (symbol-value ov))
656 (ti::funcall 'overlay-start ov)
657 (ti::funcall 'extent-start-position ov))
661 (ti::funcall 'overlay-end ov)
662 (ti::funcall 'extent-end-position ov))
664 (setq this-command 'set-mark)))))
666 ;;; ----------------------------------------------------------------------
668 (defun tinymailbox-header-next ()
669 "Find next header forward."
670 (if (looking-at "^[^ \t\n]")
672 (while (and (not (eobp)) (looking-at "^[ \t]"))
675 ;;; ----------------------------------------------------------------------
677 (defun tinymailbox-header-show-or-hide ()
678 "Check `tinymailbox-:header-hide-mode' and act according to it."
679 (if tinymailbox-:header-hide-mode
680 (tinymailbox-header-hide)
681 (tinymailbox-header-show)))
683 ;;; ----------------------------------------------------------------------
685 (defun tinymailbox-header-show ()
686 "Call `tinymailbox-header-hide' with argument SHOW."
688 (tinymailbox-header-hide 'show))
690 ;;; ----------------------------------------------------------------------
692 (defun tinymailbox-header-hide (&optional show)
693 "Hide or SHOW headers according to `tinymailbox-:header-show-regexp'."
695 (let* ((re tinymailbox-:header-show-regexp)
697 (propl (list 'owner 'timbx
698 'tinymailbox-stat 'hidden
701 (prop-stat 'tinymailbox-stat)
706 (tinymailbox-header-macro
707 (with-buffer-modified
709 ;; The hide on/off information is stored to the message beginning
710 ;; - We look if it says 'hidden or 'shown
711 ;; - If the user wants hidden headers, but they are already
712 ;; hidden, then this function does nothing.
713 (setq status-property
714 (memq prop-stat (text-properties-at (point))))
717 (setq put-property 'shown)
718 (when (or (null status-property)
719 ;; If text is already shown, then do nothing.
721 (not (eq (nth 1 status-property) 'shown))))
722 (ti::text-property-search-and-modify
723 '(owner timbx) nil beg end)))
725 (setq put-property 'hidden)
726 (when (or (null status-property)
728 (not (eq (nth 1 status-property) 'hidden))))
729 (while (< (point) end)
731 ((and (not (looking-at re))
732 ;; If this point has already marked visible, do nothing.
734 (get-text-property (point) 'owner)))
735 (null (get-text-property (point) prop))))
737 (tinymailbox-header-next)
738 (with-buffer-modified
739 (let (buffer-read-only)
740 (set-text-properties point (point) propl))))
742 (forward-line 1)))))))
743 (put-text-property beg (1+ beg) 'owner 'timbx)
744 (put-text-property beg (1+ beg) prop-stat put-property)))
750 ;;; ----------------------------------------------------------------------
753 (defun tinymailbox-fmacro-move-1 (func doc move-func re msg &rest body)
754 "Use `tinymailbox-fmacro-move with FUNC DOC MOVE-FUNC RE MSG and BODY."
755 (let* ((sym (intern (symbol-name (` (, func))))))
757 (defun (, sym) (&optional arg)
760 (let* ((Opoint (point))
762 (if (eq (, move-func) 're-search-backward)
766 ((setq stat (funcall (, move-func) (, re) nil t))
767 (goto-char (match-end 0)))
770 (tinymailbox-header-show-or-hide)
774 (when (and (null stat) (interactive-p))
778 ) ;; eval-and-compile
780 ;;; ----------------------------------------------------------------------
782 (defmacro tinymailbox-fmacro-move (func doc move-func re msg &optional body)
783 "Create Move function FUNC DOC MOVE-FUNC RE MSG and BODY.
784 Created function arguments: (&optional arg)"
785 (` (, (tinymailbox-fmacro-move-1
786 func doc move-func re msg body))))
788 ;;; ----------------------------------------------------------------------
790 ;;;###autoload (autoload 'tinymailbox-forward "tinymailbox" "Go to next message." t)
791 (tinymailbox-fmacro-move
793 "Go to next message."
794 're-search-forward tinymailbox-:move-header-regexp
795 "TinyMailbox: message forward stop.")
797 ;;; ----------------------------------------------------------------------
799 ;;;###autoload (autoload 'tinymailbox-backward "tinymailbox" "Go to previous message." t)
800 (tinymailbox-fmacro-move
802 "Go to previous message."
803 're-search-backward tinymailbox-:move-header-regexp
804 "TinyMailbox: message backward stop.")
806 ;;; ----------------------------------------------------------------------
808 (tinymailbox-fmacro-move
809 tinymailbox-forward-body
810 "Go to next message body."
811 're-search-forward "^From "
812 "TinyMailbox: body forward stop."
814 (setq stat (re-search-forward "^[ \t]*$" nil t))))
816 ;;; ----------------------------------------------------------------------
818 (defun tinymailbox-backward-body ()
819 "Go to previous message body."
821 (let* ((opoint (point))
823 ;; We must move to message beginning first.
824 (tinymailbox-message-move-beginning)
826 (if (null (re-search-backward "^From " nil t))
827 (message "TinyMailbox: body backward stop.")
828 (setq stat (re-search-forward "^[ \t]*$" nil t)))
832 ;; If none found, return to original position
833 (when (and (null stat)
834 (not (eq (point) opoint)))
835 (message "TinyMailbox: body backward stop.")
836 (goto-char opoint))))
838 ;;; ----------------------------------------------------------------------
840 (defun tinymailbox-header-hide-mode (arg &optional verb)
841 "Toggle header hiding mode with ARG when moving between messages. VERB."
844 (ti::bool-toggle tinymailbox-:header-hide-mode)
846 (message "Header hiding mode is %s"
847 (if tinymailbox-:header-hide-mode "on" "off")))
848 (tinymailbox-header-show-or-hide))
853 ;;; ----------------------------------------------------------------------
856 (defun tinymailbox-begin (&optional backward)
857 "Move to next message begin. Optionally BACKWARD."
859 (let* ((re tinymailbox:-header-begin-regexp)
863 (if (re-search-backward re nil t)
864 (skip-chars-forward "^a-z") ;; Go to character
867 (goto-char (line-end-position))
868 (unless (re-search-forward re nil t)
870 (beginning-of-line)))
872 ;;; ----------------------------------------------------------------------
875 (defun tinymailbox-delete ()
876 "Delete current message. point must be inside message."
879 (tinymailbox-message-macro
881 (kill-region beg (point))))
883 ;;; ----------------------------------------------------------------------
886 (defun tinymailbox-copy ()
887 "Copy current message. point must be inside message."
889 (tinymailbox-message-macro
890 (copy-region-as-kill beg end)
891 (tinymailbox-overlay 'show beg end)
893 (tinymailbox-overlay 'hide beg end)
895 (message "TinyMailbox: Message copied as kill."))))
897 ;;; ----------------------------------------------------------------------
900 (defun tinymailbox-copy-body ()
901 "Copy body of current message. point must be inside message."
904 (tinymailbox-message-macro
905 ;; body starts after all headers.
907 (re-search-forward "^[ \t]*$")
910 (copy-region-as-kill beg end)
911 (tinymailbox-overlay 'show beg end))
913 (message "TinyMailbox: Message body copied.")))
915 ;;; ----------------------------------------------------------------------
918 (defun tinymailbox-message-to-folder (file)
919 "File current message by appending it to FILE."
924 (if tinymailbox-:last-file
925 (file-name-directory tinymailbox-:last-file))
928 (if tinymailbox-:last-file
929 (file-name-nondirectory tinymailbox-:last-file)))))
930 (tinymailbox-message-macro
931 (setq tinymailbox-:last-file file)
932 (append-to-file beg (min (1+ end) (point-max)) file)
935 ;;; ----------------------------------------------------------------------
938 (defun tinymailbox-message-write-file (file)
943 (if tinymailbox-:last-file
944 (file-name-directory tinymailbox-:last-file))
947 (if tinymailbox-:last-file
948 (file-name-nondirectory tinymailbox-:last-file)))))
949 (tinymailbox-message-macro
950 (setq tinymailbox-:last-file file)
951 (write-region beg (min (1+ end) (point-max)) file)
954 ;;; ----------------------------------------------------------------------
956 (defun tinymailbox-occur (regexp)
957 "Create Simple `Summary' buffer by running REGEXP `occur'.
958 Try Subject: or From:"
959 (interactive "sTinyMailbox: run occur by regexp: ")
962 (when (interactive-p)
963 (message "TinyMailbox: Occur cancelled. No REGEXP given.")))
969 ;;; ----------------------------------------------------------------------
971 (defun tinymailbox-occur-subject ()
972 "Generate Subject summary."
974 (tinymailbox-occur "^Subject:.*"))
976 ;;; ----------------------------------------------------------------------
978 (defsubst tinymailbox-user-mail-address-regexp ()
979 "Return regexp from `user-mail-address' and `user-full-name'."
981 (or user-mail-address "####none###")
983 (or user-full-name "###none###")
986 (concat user-login-name "@")
989 ;;; ----------------------------------------------------------------------
991 (defsubst tinymailbox-mail-send-filter (list &optional regexp)
992 "Remove all strings from LIST that match current user or REGEXP."
993 (let ((user (tinymailbox-user-mail-address-regexp)))
994 (remove-if (lambda (x)
995 (or (string-match user x)
996 (and (stringp regexp)
997 (string-match regexp x))))
1000 ;;; ----------------------------------------------------------------------
1002 (defun tinymailbox-mail-send-at-point ()
1003 "Compose mail using current message.
1007 (let* ((buffer (current-buffer))
1019 ;; We must "require", because `mail-yank-prefix' is not otherwise
1021 (if (not (boundp 'mail-yank-prefix))
1022 (require 'sendmail))
1023 (tinymailbox-message-macro
1024 (ti::narrow-safe beg end
1026 (setq from (mail-fetch-field "From")
1027 from-email (car-safe (ti::mail-email-from-string from))
1028 to (mail-fetch-field "to")
1029 reply-to (mail-fetch-field "reply-to")
1031 (tinymailbox-mail-send-filter
1034 "[ \t\r\n]*,[ \t\r\n]*")
1036 cc (mail-fetch-field "CC")
1038 (tinymailbox-mail-send-filter
1041 "[ \t\r\n]*,[ \t\r\n]*")
1042 (regexp-quote from-email)))
1043 references (mail-fetch-field "References")
1044 subject (mail-fetch-field "Subject")))
1045 (setq to-dest (or reply-to from))
1046 ;; Sometimes the To field contains multiple addresses
1047 ;; To: me@here.at, other@there.com
1048 ;; => Move them to CC
1049 (dolist (elt to-list)
1050 (unless (dolist (eltc cc-list)
1051 (if (string= elt eltc)
1053 (push elt cc-list)))
1055 (setq cc (mapconcat 'concat cc-list ", ")))
1057 (when (re-search-forward "^[ \t]*$")
1059 (setq body (buffer-substring (point) (point-max))))
1061 (not (ti::string-match-case "re:" subject 'ignore-case)))
1062 (setq subject (concat "Re: " subject))))
1063 (mail nil to-dest subject nil cc)
1065 (mail-position-on-field "References")
1066 (insert references))
1068 (setq start (point))
1069 (insert (or body ""))
1073 (if (stringp mail-yank-prefix)
1077 (run-hooks 'tinymailbox-:mail-setup-hook)))
1081 (add-hook 'tinymailbox-:mode-define-keys-hook 'tinymailbox-mode-define-keys)
1082 (provide 'tinymailbox)
1084 (run-hooks 'tinymailbox-:load-hook)
1086 ;;; tinymailbox.el ends here