emacs_el/mutt.el

   1 ;; mutt.el --- Use Emacs 20 as an external editor for the Mutt mailer
   2 ;; Copyright 1998 Eric Kidd
   3
   4 ;; Author: Eric Kidd <eric.kidd@pobox.com>
   5 ;; Version: $Revision: 1.4 $
   6
   7 ;; This is free software distributed under the GPL, yadda, yadda, yadda.
   8 ;; It has no warranty. See the GNU General Public License for more
   9 ;; information. Send me your feature requests and patches, and I'll try
  10 ;; to integrate everything.
  11
  12 ;;; Commentary:
  13
  14 ;; This is a major mode for use with Mutt, the spiffy *nix mailreader
  15 ;; du jour. See <http://www.cs.hmc.edu/~me/mutt/index.html>. To use this
  16 ;; mode, add the following line to the .emacs file in your home directory:
  17 ;;
  18 ;;   (load "/your/local/path/to/this/file/mutt")
  19 ;;
  20 ;; Note that you can omit to ".el" from the file name when calling load.
  21 ;;
  22 ;; If you want to make it available to all your users, type \C-h v
  23 ;; load-path RET, pick an appropriate directory for mutt.el, and modify
  24 ;; your sitewide default.el to (require 'mutt).
  25
  26
  27 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  28 ;;;
  29 ;;; Thanks
  30 ;;;
  31 ;;; Dave Pearson: Code, feature ideas, Mutt experience. Many thanks!
  32 ;;; Louis Theran: Encouragement to make Mutt mode work like Emacs MUAs.
  33 ;;; Ronald: Enlightening gripes about what Emacs should do, but doesn't.
  34 ;;; Robert Napier: Bug reports about font-lock mode, fancy wrapping.
  35
  36
  37 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  38 ;;;
  39 ;;; Revision History
  40 ;;;
  41 ;;; $Log: mutt.el,v $
  42 ;;; Revision 1.4  1998/04/11 00:05:46  emk
  43 ;;; Fixed font-lock bug. Also made mutt-mode a little more careful about
  44 ;;; saving various bits of Emacs state when moving around the buffer.
  45 ;;;
  46 ;;; Revision 1.3  1998/03/25 00:37:36  emk
  47 ;;; Added support for menus and font-lock mode, plus a few bug fixes.
  48 ;;;
  49 ;;; Revision 1.2  1998/03/24 13:19:46  emk
  50 ;;; Major overhaul--more commands, a minor mode for header editing, and other
  51 ;;; desirable features. Attaching files seems to be broken, though.
  52 ;;;
  53
  54
  55 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  56 ;;;
  57 ;;; Required Packages
  58
  59 (require 'derived)
  60 (require 'cl) ; Big but featureful. Do we need this?
  61 (require 'easymenu)
  62
  63
  64 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  65 ;;;
  66 ;;; Customization Support
  67 ;;;
  68 ;;; Set up our customizable features. You can edit these (and lots of other
  69 ;;; fun stuff) by typing M-x customize RET. The Mutt preferences can be
  70 ;;; found under the [Applications] [Mail] category.
  71
  72 (defgroup mutt nil
  73   "Composing e-mail messages with Mutt.
  74 Emacs can run as an external editor for Mutt, the spiffy Unix mail reader
  75 du jour. You can get Mutt from <http://www.cs.hmc.edu/~me/mutt/index.html>."
  76   :group 'mail)
  77
  78 (defcustom mutt-uses-fill-mode t
  79   "*Specifies whether Mutt should automatically wrap lines.
  80 Set this to t to enable line wrapping, and nil to disable line
  81 wrapping. Note that if a paragraph gets messed up (the line wrapper
  82 is very primitive), you can type \\[fill-paragraph] to rewrap the paragraph."
  83   :type 'boolean
  84   :group 'mutt)
  85
  86 (defcustom mutt-signature-pattern "\\(--\\|Cheers,\\|\f\\)"
  87   "*Pattern for identifying signatures.
  88 Mutt uses this to locate signatures. It should contain no leaading or
  89 trailing whitespace."
  90   :type 'string
  91   :group 'mutt)
  92
  93 (defcustom mutt-file-pattern "mutt-[a-z]+-[0-9]+-[0-9]+\\'"
  94   "*Regular expression which matches Mutt's temporary files."
  95   :type 'string
  96   :group 'mutt)
  97
  98
  99 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 100 ;;;
 101 ;;; Customizable Faces
 102 ;;; The dark background versions are probably uglier than the light
 103 ;;; (which I use). If you find a more attractive, subdued color scheme,
 104 ;;; please mail it to me.
 105
 106 (defgroup mutt-faces nil
 107   "Typefaces used for composing messages with Mutt."
 108   :group 'mutt
 109   :group 'faces)
 110
 111 (defface mutt-header-keyword-face
 112   '((((class color)
 113       (background light))
 114      (:foreground "Navy" :bold t))
 115     (((class color)
 116       (background dark))
 117      (:foreground "LightBlue" :bold t))
 118     (t
 119      (:bold t)))
 120   "Face used for displaying keywords (e.g. \"From:\") in headers."
 121   :group 'mutt-faces)
 122
 123 (defface mutt-header-value-face
 124   '((((class color)
 125       (background light))
 126      (:foreground "MidnightBlue"))
 127     (((class color)
 128       (background dark))
 129      (:foreground "LightSteelBlue")))
 130   "Face used for displaying the values of headers."
 131   :group 'mutt-faces)
 132
 133 (defface mutt-quoted-text-face
 134   '((((class color)
 135       (background light))
 136      (:foreground "Sienna" :italic t))
 137     (((class color)
 138       (background dark))
 139      (:foreground "Wheat" :italic t))
 140     (t
 141      (:bold t :italic t)))
 142   "Face used for displaying text which has been quoted (e.g. \">foo\")."
 143   :group 'mutt-faces)
 144
 145 (defface mutt-multiply-quoted-text-face
 146   '((((class color)
 147       (background light))
 148      (:foreground "Firebrick" :italic t))
 149     (((class color)
 150       (background dark))
 151      (:foreground "Tan" :italic t))
 152     (t
 153      (:italic t)))
 154   "Face used for text which has been quoted more than once (e.g. \">>foo\")."
 155   :group 'mutt-faces)
 156
 157 (defvar mutt-font-lock-keywords
 158   '(("^\\([A-Z][-A-Za-z0-9.]+:\\)\\(.*\\)$"
 159      (1 'mutt-header-keyword-face)
 160      (2 'mutt-header-value-face))
 161     ("^[ \t\f]*\\(>[ \t\f]*[^ \t\f>].*\\)$"
 162      (1 'mutt-quoted-text-face))
 163     ("^[ \t\f]*\\(>[ \t\f]*\\)\\(>.*\\)$"
 164      (1 'mutt-quoted-text-face)
 165      (2 'mutt-multiply-quoted-text-face)))
 166   "Highlighting rules for message mode.")
 167
 168
 169 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 170 ;;;
 171 ;;; Interactive Commands
 172
 173 (defun mutt-save-current-buffer-and-exit ()
 174   "Save the current buffer and exit Emacs."
 175   (interactive)
 176   (basic-save-buffer)
 177   (save-buffers-kill-emacs))
 178
 179 (defun mutt-delete-quoted-signatures ()
 180   "Delete quoted signatures from buffer."
 181   (interactive)
 182   (goto-char (point-min))
 183   (flush-lines (concat "^\\([ \t\f]*>[ \t\f>]*\\)"
 184                        mutt-signature-pattern
 185                        "[ \t\f]*\\(\n\\1.*\\)*")))
 186
 187 (defun mutt-delete-old-citations ()
 188   "Delete citations more than one level deep from buffer."
 189   (interactive)
 190   (goto-char (point-min))
 191   (flush-lines "^[ \t\f]*>[ \t\f]*>[ \t\f>]*"))
 192
 193 (defun mutt-goto-body ()
 194   "Go to the beginning of the message body."
 195   (interactive)
 196   (goto-char (point-min))
 197   ;; If the message has headers, slide downward.
 198   (and headers-mode
 199        (save-match-data (re-search-forward "^$" nil t))
 200        (next-line 1)))
 201
 202 (defun mutt-goto-signature ()
 203   "Go to the beginning of the message signature."
 204   (interactive)
 205   (goto-char (point-max))
 206   (and (save-match-data
 207          (re-search-backward (concat "^" mutt-signature-pattern
 208                                      "[ \t\f]*$")
 209                              nil t))
 210        (previous-line 1)))
 211
 212
 213 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 214 ;;;
 215 ;;; Mutt Mode Meat
 216
 217 (define-derived-mode mutt-mode text-mode "Mutt"
 218   "Major mode for composing E-mail with the Mutt mailer.
 219 To customize it, type \\[customize] and select [Applications] [Mail] [Mutt].
 220 When you finish editing this message, type \\[mutt-save-current-buffer-and-exit] to save and exit Emacs.
 221
 222 \\{mutt-mode-map}"
 223
 224   (rename-buffer "*Composing*" t)
 225   (auto-fill-mode (if mutt-uses-fill-mode 1 0))
 226
 227   ;; Make Emacs smarter about wrapping citations and paragraphs.
 228   ;; We probably can't handle Supercited messages, though.
 229   (make-local-variable 'paragraph-start)
 230   (make-local-variable 'paragraph-separate)
 231   (setq paragraph-start
 232         "\\([ \t\n\f]+[^ \t\n\f>]\\|[ \t\f>]*$\\)"
 233         paragraph-separate
 234         "[ \t\f>]*$")
 235
 236   ;; If Mutt passed us headers, activate the necessary commands.
 237   (when (looking-at "^[-A-Za-z0-9]+:")
 238     (headers-mode 1))
 239
 240   ;; Our temporary file lives in /tmp. Yuck! Compensate appropriately.
 241   (make-local-variable 'backup-inhibited)
 242   (setq backup-inhibited t)
 243   (cd "~")
 244
 245   (make-local-variable 'font-lock-defaults)
 246   (setq font-lock-defaults '(mutt-font-lock-keywords t))
 247
 248   (mutt-goto-body)
 249   (message (substitute-command-keys "Type \\[describe-mode] for help composing; \\[mutt-save-current-buffer-and-exit] when done.")))
 250
 251
 252 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 253 ;;;
 254 ;;; Mutt Headers Mode
 255
 256 (defvar headers-mode nil)
 257
 258 (defun headers-mode (&optional arg)
 259   "Commands for editing the headers of an e-mail or news message.
 260
 261 \\{headers-mode-map}"
 262
 263   (interactive "P")
 264   (make-local-variable 'headers-mode)
 265   (setq headers-mode
 266         (if (null arg)
 267             (not headers-mode)
 268           (> (prefix-numeric-value arg) 0)))
 269   (force-mode-line-update))
 270
 271 (defvar headers-mode-map (make-sparse-keymap)
 272   "Keymap used for editing RFC822 headers.")
 273
 274 (defun headers-position-on-value ()
 275   (beginning-of-line)
 276   (skip-chars-forward "-A-Za-z0-9:")
 277   ;; XXX - Should make sure we stay on line.
 278   (forward-char))
 279
 280 (defun headers-goto-field (field)
 281   (let ((case-fold-search t))
 282     (goto-char (point-min))
 283     (save-match-data
 284       (when (re-search-forward (concat "^\\($\\|" field ": \\)"))
 285         (if (looking-at "^$")
 286             (progn
 287               (insert-string field ": \n")
 288               (forward-char -1))
 289           (headers-position-on-value))))))
 290
 291 (defmacro define-header-goto (name header)
 292   `(defun ,name ()
 293      ,(concat "Position the cursor on the " header ": header.")
 294      (interactive)
 295      (headers-goto-field ,header)))
 296
 297 (define-header-goto headers-goto-to "To")
 298 (define-header-goto headers-goto-cc "Cc")
 299 (define-header-goto headers-goto-fcc "Fcc")
 300 (define-header-goto headers-goto-summary "Summary")
 301 (define-header-goto headers-goto-keywords "Keywords")
 302 (define-header-goto headers-goto-subject "Subject")
 303 (define-header-goto headers-goto-bcc "Bcc")
 304 (define-header-goto headers-goto-reply-to "Reply-To")
 305 (define-header-goto headers-goto-from "From")
 306 (define-header-goto headers-goto-organization "Organization")
 307
 308 (defun headers-attach-file (file description)
 309   "Attach a file to the current message (works with Mutt)."
 310   (interactive "fAttach file: \nsDescription: ")
 311   (when (> (length file) 0)
 312     (save-excursion
 313       (save-match-data
 314         (save-restriction
 315           (widen)
 316           (goto-char (point-min))
 317           (search-forward-regexp "^$")
 318           (insert-string (concat "Attach: " (file-truename file) " "
 319                                  description "\n"))
 320           (message (concat "Attached '" file "'.")))))))
 321
 322 (or (assq 'headers-mode minor-mode-alist)
 323     (setq minor-mode-alist
 324           (cons '(headers-mode " Headers") minor-mode-alist)))
 325
 326 (or (assq 'headers-mode minor-mode-map-alist)
 327     (setq minor-mode-map-alist
 328           (cons (cons 'headers-mode headers-mode-map)
 329                 minor-mode-map-alist)))
 330
 331
 332 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 333 ;;;
 334 ;;; Key Bindings
 335
 336 (define-key mutt-mode-map "\C-c\C-c" 'mutt-save-current-buffer-and-exit)
 337 (define-key mutt-mode-map "\C-c\C-d\C-s" 'mutt-delete-quoted-signatures)
 338 (define-key mutt-mode-map "\C-c\C-d\C-c" 'mutt-delete-old-citations)
 339 (define-key mutt-mode-map "\C-c\C-b" 'mutt-goto-body)
 340 (define-key mutt-mode-map "\C-c\C-i" 'mutt-goto-signature)
 341
 342 (define-key headers-mode-map "\C-c\C-f\C-t" 'headers-goto-to)
 343 (define-key headers-mode-map "\C-c\C-f\C-c" 'headers-goto-cc)
 344 (define-key headers-mode-map "\C-c\C-f\C-w" 'headers-goto-fcc)
 345 (define-key headers-mode-map "\C-c\C-f\C-u" 'headers-goto-summary)
 346 (define-key headers-mode-map "\C-c\C-f\C-k" 'headers-goto-keywords)
 347 (define-key headers-mode-map "\C-c\C-f\C-s" 'headers-goto-subject)
 348 (define-key headers-mode-map "\C-c\C-f\C-b" 'headers-goto-bcc)
 349 (define-key headers-mode-map "\C-c\C-f\C-r" 'headers-goto-reply-to)
 350 (define-key headers-mode-map "\C-c\C-f\C-f" 'headers-goto-from)
 351 (define-key headers-mode-map "\C-c\C-f\C-o" 'headers-goto-organization)
 352 (define-key headers-mode-map "\C-c\C-a" 'headers-attach-file)
 353
 354
 355 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 356 ;;;
 357 ;;; Menus
 358
 359 (easy-menu-define
 360  mutt-mode-menu mutt-mode-map "Mutt Message Composition Commands."
 361  '("Mutt"
 362    ["Delete Quoted Signatures" mutt-delete-quoted-signatures t]
 363    ["Delete Doubly-Quoted Text" mutt-delete-old-citations t]
 364    "----"
 365    ["Go To Body of Message" mutt-goto-body t]
 366    ["Go To Signature of Message" mutt-goto-signature t]
 367    "----"
 368    ["Save Message and Return to Mutt" mutt-save-current-buffer-and-exit t]))
 369
 370 (easy-menu-define
 371  headers-mode-menu headers-mode-map "Header Editing Commands."
 372  '("Headers"
 373    ["Attach File..." headers-attach-file t]
 374    "----"
 375    ["Edit From Header" headers-goto-from t]
 376    ["Edit Subject Header" headers-goto-subject t]
 377    ["Edit To Header" headers-goto-to t]
 378    ["Edit Cc Header" headers-goto-cc t]
 379    ["Edit Bcc Header" headers-goto-bcc t]
 380    ["Edit Fcc Header" headers-goto-fcc t]
 381    ["Edit Reply-To Header" headers-goto-reply-to t]
 382    ["Edit Summary Header" headers-goto-summary t]
 383    ["Edit Keywords Header" headers-goto-keywords t]
 384    ["Edit Organization Header" headers-goto-organization t]))
 385
 386
 387 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 388 ;;;
 389 ;;; Finish Installing Mutt Mode
 390
 391 (unless (assq mutt-file-pattern auto-mode-alist)
 392   (setq auto-mode-alist
 393         (cons (cons mutt-file-pattern 'mutt-mode)
 394               auto-mode-alist)))
 395
 396 (provide 'mutt)