From: Jesse Rosenthal <jrosenthal@jhu.edu>
To: notmuch@notmuchmail.org
Date: Sat, 20 Feb 2010 22:12:21 -0500
Message-ID: <87sk8vz3hm.fsf@jhu.edu>
MIME-Version: 1.0
Content-Type: text/plain; charset=us-ascii
Subject: [notmuch] tach.el: An interface for handling attachments in
	message-mode
Precedence: list

Dear all,

Sending email in emacs message-mode is great, but the handling of
(outgoing) attachments leaves a lot to be desired. MML's markup can be
confusing, and can easily be edited by mistake.

Thus: tach.el. Tach is a minor mode that adds mutt-like attachment
handling to message mode. It's not notmuch specific, but I wrote it to
use with notmuch, and I thought it might be of use to some on the
list. 

You can get tach by typing:

git clone http://jkr.acm.jhu.edu/git/tach.git

Also, because the server has been a bit spotty recently, I've put the
current version of the file at the end of this message.

To use tach, put tach.el in your load-path, and add the following to
your .emacs:

(require 'tach)
(add-hook 'message-mode-hook 'tach-minor-mode)

Now when you type "C-c C-a" in message-mode, you should get a new window
with an attachment list. In that window, you can add and delete
attachments using `+' and `-', and scroll through them using the arrow
keys or the emacs direction commands.

tach.el will convert the attachments into MML markup as a last
step before sending. Hopefully you should never have to deal with it by
hand.

Some details: tach actually makes a numerical list at the bottom of the
message itself, separated by a custom separator. The message is narrowed
to above this separator, and the attachment window is an indirect buffer
narrowed to the region below the separator. The separator is erased when
the messages are translated to mml markup at the end.

This is still a work in its earliest stages, and the usual disclaimers
apply. It certainly needs more a lot more commenting and
documentation. But I thought it might be useful, or at least fun to play
around with, and I'd love to hear any feedback. As I said, it's not
notmuch-specific, so I'm not sending it as a patch, but if people like
it, we might also consider making it part of the notmuch emacs bundle,
at some point in its future development.

Best,
Jesse

-----------FILE--BELOW----------------------
;; tach.el -- Interface for handling attachments in message-mode

;; Filename: tach.el
;; Copyright (C) 2010 Jesse Rosenthal
;; Author: Jesse Rosenthal <jrosenthal@jhu.edu>
;; Maintainer: Jesse Rosenthal <jrosenthal@jhu.edu>
;; Created: 18 Feb 2010
;; Description: Handles attachments for message mode
;; Version 0.01alpha

;; This file is not part of GNU Emacs.

;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published
;; by the Free Software Foundation; either version 2, or (at your
;; option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Commentary:

;; To use: add the following to your .emacs: 
;;   (require 'tach)
;;   (add-hook 'message-mode-hook 'tach-minor-mode)
;;
;; Pressing `C-cC-a' in message mode will open up an attachment
;; window. The first time you open it, it will prompt for a file name.
;;
;; In the attachment window, you can press `+' to add a file, or `-'
;; to remove one.
;;
;; Note that the attachment window is actually a different view of the
;; message buffer, so that if there is some failure, the attachment
;; list will be saved at the bottom of the message, as a numerical
;; list under a customizable separator.
;;
;; The files will be added to the outgoing message by mml before it is
;; sent.


(require 'message)
(require 'mml)

(defconst tach-sep  "--attachments follow this line--")

(defconst tach-line-regexp "^\\([0-9]+.\\) +\\(.+?\\) +\\(\\[.+, [0-9\.]+[KM]\\]\\)$")

(defvar tach-send-confirmation nil)

(defvar tach-buffer-name)
(make-variable-buffer-local 'tach-buffer-name)

(defvar tach-mode-hooks 'nil)
(make-variable-buffer-local 'tach-mode-hooks)

(defvar tach-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map "+" 'tach-add-file)
    (define-key map "-" 'tach-delete-file)
    (define-key map "\C-c\C-c" 'tach-send-from-attach-buffer)
    (define-key map [up] 'tach-prev-entry)
    (define-key map [down] 'tach-next-entry)
    (define-key map "n" 'tach-next-entry)
    (define-key map "p" 'tach-prev-entry)
    (define-key map "\C-n" 'tach-next-entry)
    (define-key map "\C-p" 'tach-prev-entry)
    map)
  "Keymap for attachment mode")
(fset 'tach-mode-map tach-mode-map)

(defvar tach-minor-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map "\C-c\C-a"  'tach-goto)
    map)
  "Keymap for attachment minor mode")
(fset 'tach-minor-mode-map tach-minor-mode-map)

(defun tach-mode ()
  (interactive)
  (kill-all-local-variables)
  (use-local-map 'tach-mode-map)
  (hl-line-mode 1)
  (setq major-mode 'tach-mode
	mode-name "attachment")
  (run-hooks 'tach-mode-hooks)
  (widen)
  (narrow-to-region (tach-buffer-point-min) (point-max))
  (setq buffer-read-only t))

(defun tach-buffer-point-min ()
  (save-excursion
    (goto-char (point-max))
    (search-backward-regexp tach-sep)
    (search-forward-regexp (concat tach-sep "\n"))
    (point)))


(defun tach-message-point-max ()
  (save-excursion
    (goto-char (point-max))
    (search-backward-regexp tach-sep)
    (point)))
  

(defun tach-first-entry-p ()
  (save-restriction
    (widen)
    (save-excursion
      (forward-line -1)
      (looking-at (concat "^" tach-sep "%")))))

(defun tach-last-entry-p ()
  (save-excursion
    (forward-line)
    (looking-at "^\s*$")))

(defun tach-next-entry ()
  (interactive)
  (unless (tach-last-entry-p)
    (forward-line 1)))

(defun tach-prev-entry ()
  (interactive)
  (unless (tach-first-entry-p)
    (forward-line -1)))
    

(defun tach-has-attachments-p ()
  (interactive)
  (save-excursion
  (goto-char (point-max))
  (cond ((re-search-backward (concat "^" tach-sep "$")  nil t)
	 (forward-line)
	 (while (looking-at tach-line-regexp)
	   (forward-line))
	 (let ((remaining 
		(buffer-substring-no-properties (point) (point-max))))
	   (if (string-match "[^\s\n]" remaining)
	       nil
	     t)))
	(t
	 nil))))

(defun tach-message-initialize ()
  (save-excursion
   (unless (tach-has-attachments-p)
     (goto-char (point-max))
     (insert (concat "\n" tach-sep "\n")))
    (narrow-to-region (point-min) (tach-message-point-max))))

(defun tach-goto ()
  (interactive)
  (if (get-buffer tach-buffer-name)
      (pop-to-buffer tach-buffer-name)
    ;else
    (tach-message-initialize)
    (pop-to-buffer (make-indirect-buffer 
		    (current-buffer)
		    tach-buffer-name)))
  (tach-mode))

(defun tach-read-list ()
  (save-excursion
    (let ((output nil))
      (goto-char (point-max))
      (re-search-backward (concat "^" tach-sep "$"))
      (forward-line)
      (while (and (looking-at tach-line-regexp)
		  (not (= (line-end-position) (point-max))))
	(setq output (cons (replace-regexp-in-string
			    tach-line-regexp "\\2"
			    (buffer-substring-no-properties (line-beginning-position) (line-end-position)))
			   output))
	(forward-line))
      (reverse output))))

(defun tach-delete-list ()
  (save-excursion
    (goto-char (point-max))
    (re-search-backward (concat "^" tach-sep "$"))
    (end-of-line)
    (delete-region (point) (point-max))))

(defun tach-write-list (lst)
  (save-excursion
    (goto-char (point-max))
    (re-search-backward (concat "^" tach-sep "$"))
    (end-of-line)
    (newline)
    (let ((counter 1))
      (dolist (elt lst)
	(insert (concat (int-to-string counter) ". " elt
			"  ["
			(if (mm-default-file-encoding elt)
			    (mm-default-file-encoding elt)
			  "(type unknown)")
			", "
			(tach-format-file-size (nth 7 (file-attributes elt)))
			"]"))
	(newline)
	(setq counter (+ counter 1))))))

(defun tach-format-file-size (bytes)
  (let ((kbytes (fceiling (/ bytes 1024.0))))
    (cond ((< kbytes 1)p
	   (format "%.1fK" kbytes))
	  ((< kbytes 1000) 
	   (format "%.0fK" kbytes))
	  (t
	   (format "%.1fM" (/ kbytes 1000.0))))))

(defun tach-first-n-items (lst n)
  (let ((x 0)
	y)
    (if (> n (length lst))
	(setq y lst)
      (while (< x n)
	(setq y (nconc y (list (nth x lst)))
	      x (1+ x))))
    y))

(defun tach-insert-item-at-idx (item idx lst)
  (append (tach-first-n-items lst idx) (cons item (nthcdr idx lst))))

(defun tach-remove-item-at-idx (idx lst)
  (append (tach-first-n-items lst idx) (nthcdr (+ 1 idx) lst)))

(defun tach-add-file (f &optional idx)
  (interactive "fFile to attach: ")
  (if (file-directory-p f)
      (error "Cannot attach a directory")
    ;;else
    (when buffer-read-only
      (setq buffer-read-only nil))
    (widen)
    (let ((file-lst (tach-read-list))
	  (orig-line (line-number-at-pos))
	  (orig-point (point)))
      (tach-delete-list)
      (when (null idx)
	(cond ((= (length file-lst) 0)
	       (setq idx 0))
	      (t
	       (setq idx (- orig-line (line-number-at-pos))))))
      (tach-write-list 
       (tach-insert-item-at-idx f idx file-lst)))
      (narrow-to-region (tach-buffer-point-min) (point-max))
      (forward-line idx)
      (when (null buffer-read-only)
	(setq buffer-read-only t))))

(defun tach-delete-file (&optional idx)
  (interactive)
    (when buffer-read-only
      (setq buffer-read-only nil))
    (widen)
    (let ((file-lst (tach-read-list))
	  (orig-line (line-number-at-pos))
	  (orig-point (point)))
      (tach-delete-list)
      (when (null idx)
	(setq idx (- (- orig-line (line-number-at-pos)) 1)))
      (tach-write-list (tach-remove-item-at-idx idx file-lst)))
    (narrow-to-region (tach-buffer-point-min) (point-max))
    (unless (= idx 0)
      (forward-line (- idx 1)))
    (when (null buffer-read-only)
      (setq buffer-read-only t)))

(defun tach-mml-files ()
  (interactive)
  (when (tach-has-attachments-p)
  (widen)
  (let ((file-lst (tach-read-list)))
    (tach-delete-list)
    (goto-char (point-max))
    (re-search-backward (concat "^" tach-sep "$"))
    (delete-region (point) (point-max))
    (newline)
    (dolist (f file-lst)
      (mml-attach-file f)
      (goto-char (point-max))))))


(defun tach-kill-buffer ()
  (when (get-buffer tach-buffer-name)
    (delete-windows-on tach-buffer-name)
    (kill-buffer tach-buffer-name)))

(defun tach-send-from-attach-buffer ()
  (interactive)
  (when (buffer-base-buffer tach-buffer-name)
    (with-current-buffer (buffer-base-buffer tach-buffer-name)
      (message-send-and-exit))))



(define-minor-mode tach-minor-mode ()
  nil
  " Tach"
  'tach-minor-mode-map
  (if tach-minor-mode
      (progn
  	;; set the attachment buffer local variable
  	(setq tach-buffer-name
  	      (generate-new-buffer-name
  	       (concat 
  		"*"
  		(replace-regexp-in-string 
  		 "^\\(\**\\)\\(.*?\\)\\(\**\\)$" "\\2" (buffer-name))
  		"-attachments*")))
  	;; add the send hook
  	(add-hook 'message-send-hook '(lambda ()
  					     (tach-mml-files)
  					     (tach-kill-buffer))))
    ;; remove the send hook
    (remove-hook 'message-send-hook '(lambda ()
  					    (tach-mml-files)
  					    (tach-kill-buffer)))))



    
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(provide 'tach)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;