e6/c9d6a4125c511f98099861d9ad3cd4c0c695fb

   1 Return-Path: <prvs=jrosenthal=661f23afb@jhu.edu>\r
   2 X-Original-To: notmuch@notmuchmail.org\r
   3 Delivered-To: notmuch@notmuchmail.org\r
   4 Received: from localhost (localhost [127.0.0.1])\r
   5         by olra.theworths.org (Postfix) with ESMTP id B4E50431FAE\r
   6         for <notmuch@notmuchmail.org>; Sat, 20 Feb 2010 19:13:04 -0800 (PST)\r
   7 X-Virus-Scanned: Debian amavisd-new at olra.theworths.org\r
   8 X-Spam-Flag: NO\r
   9 X-Spam-Score: -3.314\r
  10 X-Spam-Level: \r
  11 X-Spam-Status: No, score=-3.314 tagged_above=-999 required=5 tests=[AWL=0.871,\r
  12         BAYES_40=-0.185, RCVD_IN_DNSWL_MED=-4] autolearn=ham\r
  13 Received: from olra.theworths.org ([127.0.0.1])\r
  14         by localhost (olra.theworths.org [127.0.0.1]) (amavisd-new, port 10024)\r
  15         with ESMTP id QlAli8z6UhxA for <notmuch@notmuchmail.org>;\r
  16         Sat, 20 Feb 2010 19:13:01 -0800 (PST)\r
  17 Received: from ipex2.johnshopkins.edu (ipex2.johnshopkins.edu [162.129.8.151])\r
  18         by olra.theworths.org (Postfix) with ESMTP id F1A3E431FBC\r
  19         for <notmuch@notmuchmail.org>; Sat, 20 Feb 2010 19:13:00 -0800 (PST)\r
  20 X-IronPort-AV: E=Sophos;i="4.49,510,1262581200"; d="scan'208";a="306076623"\r
  21 Received: from c-69-255-36-229.hsd1.md.comcast.net (HELO lucky)\r
  22         ([69.255.36.229])\r
  23         by ipex2.johnshopkins.edu with ESMTP/TLS/AES256-SHA;\r
  24         20 Feb 2010 22:12:59 -0500\r
  25 Received: from jkr by lucky with local (Exim 4.69)\r
  26         (envelope-from <jrosenthal@jhu.edu>)\r
  27         id 1Nj2F3-0003hF-Ch; Sat, 20 Feb 2010 22:12:21 -0500\r
  28 From: Jesse Rosenthal <jrosenthal@jhu.edu>\r
  29 To: notmuch@notmuchmail.org\r
  30 Date: Sat, 20 Feb 2010 22:12:21 -0500\r
  31 Message-ID: <87sk8vz3hm.fsf@jhu.edu>\r
  32 MIME-Version: 1.0\r
  33 Content-Type: text/plain; charset=us-ascii\r
  34 Subject: [notmuch] tach.el: An interface for handling attachments in\r
  35         message-mode\r
  36 X-BeenThere: notmuch@notmuchmail.org\r
  37 X-Mailman-Version: 2.1.13\r
  38 Precedence: list\r
  39 List-Id: "Use and development of the notmuch mail system."\r
  40         <notmuch.notmuchmail.org>\r
  41 List-Unsubscribe: <http://notmuchmail.org/mailman/options/notmuch>,\r
  42         <mailto:notmuch-request@notmuchmail.org?subject=unsubscribe>\r
  43 List-Archive: <http://notmuchmail.org/pipermail/notmuch>\r
  44 List-Post: <mailto:notmuch@notmuchmail.org>\r
  45 List-Help: <mailto:notmuch-request@notmuchmail.org?subject=help>\r
  46 List-Subscribe: <http://notmuchmail.org/mailman/listinfo/notmuch>,\r
  47         <mailto:notmuch-request@notmuchmail.org?subject=subscribe>\r
  48 X-List-Received-Date: Sun, 21 Feb 2010 03:13:04 -0000\r
  49 \r
  50 Dear all,\r
  51 \r
  52 Sending email in emacs message-mode is great, but the handling of\r
  53 (outgoing) attachments leaves a lot to be desired. MML's markup can be\r
  54 confusing, and can easily be edited by mistake.\r
  55 \r
  56 Thus: tach.el. Tach is a minor mode that adds mutt-like attachment\r
  57 handling to message mode. It's not notmuch specific, but I wrote it to\r
  58 use with notmuch, and I thought it might be of use to some on the\r
  59 list. \r
  60 \r
  61 You can get tach by typing:\r
  62 \r
  63 git clone http://jkr.acm.jhu.edu/git/tach.git\r
  64 \r
  65 Also, because the server has been a bit spotty recently, I've put the\r
  66 current version of the file at the end of this message.\r
  67 \r
  68 To use tach, put tach.el in your load-path, and add the following to\r
  69 your .emacs:\r
  70 \r
  71 (require 'tach)\r
  72 (add-hook 'message-mode-hook 'tach-minor-mode)\r
  73 \r
  74 Now when you type "C-c C-a" in message-mode, you should get a new window\r
  75 with an attachment list. In that window, you can add and delete\r
  76 attachments using `+' and `-', and scroll through them using the arrow\r
  77 keys or the emacs direction commands.\r
  78 \r
  79 tach.el will convert the attachments into MML markup as a last\r
  80 step before sending. Hopefully you should never have to deal with it by\r
  81 hand.\r
  82 \r
  83 Some details: tach actually makes a numerical list at the bottom of the\r
  84 message itself, separated by a custom separator. The message is narrowed\r
  85 to above this separator, and the attachment window is an indirect buffer\r
  86 narrowed to the region below the separator. The separator is erased when\r
  87 the messages are translated to mml markup at the end.\r
  88 \r
  89 This is still a work in its earliest stages, and the usual disclaimers\r
  90 apply. It certainly needs more a lot more commenting and\r
  91 documentation. But I thought it might be useful, or at least fun to play\r
  92 around with, and I'd love to hear any feedback. As I said, it's not\r
  93 notmuch-specific, so I'm not sending it as a patch, but if people like\r
  94 it, we might also consider making it part of the notmuch emacs bundle,\r
  95 at some point in its future development.\r
  96 \r
  97 Best,\r
  98 Jesse\r
  99 \r
 100 -----------FILE--BELOW----------------------\r
 101 ;; tach.el -- Interface for handling attachments in message-mode\r
 102 \r
 103 ;; Filename: tach.el\r
 104 ;; Copyright (C) 2010 Jesse Rosenthal\r
 105 ;; Author: Jesse Rosenthal <jrosenthal@jhu.edu>\r
 106 ;; Maintainer: Jesse Rosenthal <jrosenthal@jhu.edu>\r
 107 ;; Created: 18 Feb 2010\r
 108 ;; Description: Handles attachments for message mode\r
 109 ;; Version 0.01alpha\r
 110 \r
 111 ;; This file is not part of GNU Emacs.\r
 112 \r
 113 ;; This file is free software; you can redistribute it and/or modify\r
 114 ;; it under the terms of the GNU General Public License as published\r
 115 ;; by the Free Software Foundation; either version 2, or (at your\r
 116 ;; option) any later version.\r
 117 \r
 118 ;; This program is distributed in the hope that it will be useful,\r
 119 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of\r
 120 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the\r
 121 ;; GNU General Public License for more details.\r
 122 \r
 123 ;; You should have received a copy of the GNU General Public License\r
 124 ;; along with GNU Emacs; see the file COPYING.  If not, write to the\r
 125 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,\r
 126 ;; Boston, MA 02110-1301, USA.\r
 127 \r
 128 ;;; Commentary:\r
 129 \r
 130 ;; To use: add the following to your .emacs: \r
 131 ;;   (require 'tach)\r
 132 ;;   (add-hook 'message-mode-hook 'tach-minor-mode)\r
 133 ;;\r
 134 ;; Pressing `C-cC-a' in message mode will open up an attachment\r
 135 ;; window. The first time you open it, it will prompt for a file name.\r
 136 ;;\r
 137 ;; In the attachment window, you can press `+' to add a file, or `-'\r
 138 ;; to remove one.\r
 139 ;;\r
 140 ;; Note that the attachment window is actually a different view of the\r
 141 ;; message buffer, so that if there is some failure, the attachment\r
 142 ;; list will be saved at the bottom of the message, as a numerical\r
 143 ;; list under a customizable separator.\r
 144 ;;\r
 145 ;; The files will be added to the outgoing message by mml before it is\r
 146 ;; sent.\r
 147 \r
 148 \r
 149 (require 'message)\r
 150 (require 'mml)\r
 151 \r
 152 (defconst tach-sep  "--attachments follow this line--")\r
 153 \r
 154 (defconst tach-line-regexp "^\\([0-9]+.\\) +\\(.+?\\) +\\(\\[.+, [0-9\.]+[KM]\\]\\)$")\r
 155 \r
 156 (defvar tach-send-confirmation nil)\r
 157 \r
 158 (defvar tach-buffer-name)\r
 159 (make-variable-buffer-local 'tach-buffer-name)\r
 160 \r
 161 (defvar tach-mode-hooks 'nil)\r
 162 (make-variable-buffer-local 'tach-mode-hooks)\r
 163 \r
 164 (defvar tach-mode-map\r
 165   (let ((map (make-sparse-keymap)))\r
 166     (define-key map "+" 'tach-add-file)\r
 167     (define-key map "-" 'tach-delete-file)\r
 168     (define-key map "\C-c\C-c" 'tach-send-from-attach-buffer)\r
 169     (define-key map [up] 'tach-prev-entry)\r
 170     (define-key map [down] 'tach-next-entry)\r
 171     (define-key map "n" 'tach-next-entry)\r
 172     (define-key map "p" 'tach-prev-entry)\r
 173     (define-key map "\C-n" 'tach-next-entry)\r
 174     (define-key map "\C-p" 'tach-prev-entry)\r
 175     map)\r
 176   "Keymap for attachment mode")\r
 177 (fset 'tach-mode-map tach-mode-map)\r
 178 \r
 179 (defvar tach-minor-mode-map\r
 180   (let ((map (make-sparse-keymap)))\r
 181     (define-key map "\C-c\C-a"  'tach-goto)\r
 182     map)\r
 183   "Keymap for attachment minor mode")\r
 184 (fset 'tach-minor-mode-map tach-minor-mode-map)\r
 185 \r
 186 (defun tach-mode ()\r
 187   (interactive)\r
 188   (kill-all-local-variables)\r
 189   (use-local-map 'tach-mode-map)\r
 190   (hl-line-mode 1)\r
 191   (setq major-mode 'tach-mode\r
 192         mode-name "attachment")\r
 193   (run-hooks 'tach-mode-hooks)\r
 194   (widen)\r
 195   (narrow-to-region (tach-buffer-point-min) (point-max))\r
 196   (setq buffer-read-only t))\r
 197 \r
 198 (defun tach-buffer-point-min ()\r
 199   (save-excursion\r
 200     (goto-char (point-max))\r
 201     (search-backward-regexp tach-sep)\r
 202     (search-forward-regexp (concat tach-sep "\n"))\r
 203     (point)))\r
 204 \r
 205 \r
 206 (defun tach-message-point-max ()\r
 207   (save-excursion\r
 208     (goto-char (point-max))\r
 209     (search-backward-regexp tach-sep)\r
 210     (point)))\r
 211   \r
 212 \r
 213 (defun tach-first-entry-p ()\r
 214   (save-restriction\r
 215     (widen)\r
 216     (save-excursion\r
 217       (forward-line -1)\r
 218       (looking-at (concat "^" tach-sep "%")))))\r
 219 \r
 220 (defun tach-last-entry-p ()\r
 221   (save-excursion\r
 222     (forward-line)\r
 223     (looking-at "^\s*$")))\r
 224 \r
 225 (defun tach-next-entry ()\r
 226   (interactive)\r
 227   (unless (tach-last-entry-p)\r
 228     (forward-line 1)))\r
 229 \r
 230 (defun tach-prev-entry ()\r
 231   (interactive)\r
 232   (unless (tach-first-entry-p)\r
 233     (forward-line -1)))\r
 234     \r
 235 \r
 236 (defun tach-has-attachments-p ()\r
 237   (interactive)\r
 238   (save-excursion\r
 239   (goto-char (point-max))\r
 240   (cond ((re-search-backward (concat "^" tach-sep "$")  nil t)\r
 241          (forward-line)\r
 242          (while (looking-at tach-line-regexp)\r
 243            (forward-line))\r
 244          (let ((remaining \r
 245                 (buffer-substring-no-properties (point) (point-max))))\r
 246            (if (string-match "[^\s\n]" remaining)\r
 247                nil\r
 248              t)))\r
 249         (t\r
 250          nil))))\r
 251 \r
 252 (defun tach-message-initialize ()\r
 253   (save-excursion\r
 254    (unless (tach-has-attachments-p)\r
 255      (goto-char (point-max))\r
 256      (insert (concat "\n" tach-sep "\n")))\r
 257     (narrow-to-region (point-min) (tach-message-point-max))))\r
 258 \r
 259 (defun tach-goto ()\r
 260   (interactive)\r
 261   (if (get-buffer tach-buffer-name)\r
 262       (pop-to-buffer tach-buffer-name)\r
 263     ;else\r
 264     (tach-message-initialize)\r
 265     (pop-to-buffer (make-indirect-buffer \r
 266                     (current-buffer)\r
 267                     tach-buffer-name)))\r
 268   (tach-mode))\r
 269 \r
 270 (defun tach-read-list ()\r
 271   (save-excursion\r
 272     (let ((output nil))\r
 273       (goto-char (point-max))\r
 274       (re-search-backward (concat "^" tach-sep "$"))\r
 275       (forward-line)\r
 276       (while (and (looking-at tach-line-regexp)\r
 277                   (not (= (line-end-position) (point-max))))\r
 278         (setq output (cons (replace-regexp-in-string\r
 279                             tach-line-regexp "\\2"\r
 280                             (buffer-substring-no-properties (line-beginning-position) (line-end-position)))\r
 281                            output))\r
 282         (forward-line))\r
 283       (reverse output))))\r
 284 \r
 285 (defun tach-delete-list ()\r
 286   (save-excursion\r
 287     (goto-char (point-max))\r
 288     (re-search-backward (concat "^" tach-sep "$"))\r
 289     (end-of-line)\r
 290     (delete-region (point) (point-max))))\r
 291 \r
 292 (defun tach-write-list (lst)\r
 293   (save-excursion\r
 294     (goto-char (point-max))\r
 295     (re-search-backward (concat "^" tach-sep "$"))\r
 296     (end-of-line)\r
 297     (newline)\r
 298     (let ((counter 1))\r
 299       (dolist (elt lst)\r
 300         (insert (concat (int-to-string counter) ". " elt\r
 301                         "  ["\r
 302                         (if (mm-default-file-encoding elt)\r
 303                             (mm-default-file-encoding elt)\r
 304                           "(type unknown)")\r
 305                         ", "\r
 306                         (tach-format-file-size (nth 7 (file-attributes elt)))\r
 307                         "]"))\r
 308         (newline)\r
 309         (setq counter (+ counter 1))))))\r
 310 \r
 311 (defun tach-format-file-size (bytes)\r
 312   (let ((kbytes (fceiling (/ bytes 1024.0))))\r
 313     (cond ((< kbytes 1)p\r
 314            (format "%.1fK" kbytes))\r
 315           ((< kbytes 1000) \r
 316            (format "%.0fK" kbytes))\r
 317           (t\r
 318            (format "%.1fM" (/ kbytes 1000.0))))))\r
 319 \r
 320 (defun tach-first-n-items (lst n)\r
 321   (let ((x 0)\r
 322         y)\r
 323     (if (> n (length lst))\r
 324         (setq y lst)\r
 325       (while (< x n)\r
 326         (setq y (nconc y (list (nth x lst)))\r
 327               x (1+ x))))\r
 328     y))\r
 329 \r
 330 (defun tach-insert-item-at-idx (item idx lst)\r
 331   (append (tach-first-n-items lst idx) (cons item (nthcdr idx lst))))\r
 332 \r
 333 (defun tach-remove-item-at-idx (idx lst)\r
 334   (append (tach-first-n-items lst idx) (nthcdr (+ 1 idx) lst)))\r
 335 \r
 336 (defun tach-add-file (f &optional idx)\r
 337   (interactive "fFile to attach: ")\r
 338   (if (file-directory-p f)\r
 339       (error "Cannot attach a directory")\r
 340     ;;else\r
 341     (when buffer-read-only\r
 342       (setq buffer-read-only nil))\r
 343     (widen)\r
 344     (let ((file-lst (tach-read-list))\r
 345           (orig-line (line-number-at-pos))\r
 346           (orig-point (point)))\r
 347       (tach-delete-list)\r
 348       (when (null idx)\r
 349         (cond ((= (length file-lst) 0)\r
 350                (setq idx 0))\r
 351               (t\r
 352                (setq idx (- orig-line (line-number-at-pos))))))\r
 353       (tach-write-list \r
 354        (tach-insert-item-at-idx f idx file-lst)))\r
 355       (narrow-to-region (tach-buffer-point-min) (point-max))\r
 356       (forward-line idx)\r
 357       (when (null buffer-read-only)\r
 358         (setq buffer-read-only t))))\r
 359 \r
 360 (defun tach-delete-file (&optional idx)\r
 361   (interactive)\r
 362     (when buffer-read-only\r
 363       (setq buffer-read-only nil))\r
 364     (widen)\r
 365     (let ((file-lst (tach-read-list))\r
 366           (orig-line (line-number-at-pos))\r
 367           (orig-point (point)))\r
 368       (tach-delete-list)\r
 369       (when (null idx)\r
 370         (setq idx (- (- orig-line (line-number-at-pos)) 1)))\r
 371       (tach-write-list (tach-remove-item-at-idx idx file-lst)))\r
 372     (narrow-to-region (tach-buffer-point-min) (point-max))\r
 373     (unless (= idx 0)\r
 374       (forward-line (- idx 1)))\r
 375     (when (null buffer-read-only)\r
 376       (setq buffer-read-only t)))\r
 377 \r
 378 (defun tach-mml-files ()\r
 379   (interactive)\r
 380   (when (tach-has-attachments-p)\r
 381   (widen)\r
 382   (let ((file-lst (tach-read-list)))\r
 383     (tach-delete-list)\r
 384     (goto-char (point-max))\r
 385     (re-search-backward (concat "^" tach-sep "$"))\r
 386     (delete-region (point) (point-max))\r
 387     (newline)\r
 388     (dolist (f file-lst)\r
 389       (mml-attach-file f)\r
 390       (goto-char (point-max))))))\r
 391 \r
 392 \r
 393 (defun tach-kill-buffer ()\r
 394   (when (get-buffer tach-buffer-name)\r
 395     (delete-windows-on tach-buffer-name)\r
 396     (kill-buffer tach-buffer-name)))\r
 397 \r
 398 (defun tach-send-from-attach-buffer ()\r
 399   (interactive)\r
 400   (when (buffer-base-buffer tach-buffer-name)\r
 401     (with-current-buffer (buffer-base-buffer tach-buffer-name)\r
 402       (message-send-and-exit))))\r
 403 \r
 404 \r
 405 \r
 406 (define-minor-mode tach-minor-mode ()\r
 407   nil\r
 408   " Tach"\r
 409   'tach-minor-mode-map\r
 410   (if tach-minor-mode\r
 411       (progn\r
 412         ;; set the attachment buffer local variable\r
 413         (setq tach-buffer-name\r
 414               (generate-new-buffer-name\r
 415                (concat \r
 416                 "*"\r
 417                 (replace-regexp-in-string \r
 418                  "^\\(\**\\)\\(.*?\\)\\(\**\\)$" "\\2" (buffer-name))\r
 419                 "-attachments*")))\r
 420         ;; add the send hook\r
 421         (add-hook 'message-send-hook '(lambda ()\r
 422                                              (tach-mml-files)\r
 423                                              (tach-kill-buffer))))\r
 424     ;; remove the send hook\r
 425     (remove-hook 'message-send-hook '(lambda ()\r
 426                                             (tach-mml-files)\r
 427                                             (tach-kill-buffer)))))\r
 428 \r
 429 \r
 430 \r
 431     \r
 432 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\r
 433 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\r
 434 \r
 435 (provide 'tach)\r
 436 \r
 437 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\r
 438 \r