From: Jesse Rosenthal <jrosenthal@jhu.edu>
To: notmuch@notmuchmail.org
Subject: tach.el: an attachment interface for message mode.
Date: Fri, 20 Jan 2012 12:04:49 -0500
Message-ID: <877h0mwbim.fsf@jhu.edu>
MIME-Version: 1.0
Content-Type: multipart/mixed; boundary="=-=-="
Precedence: list

--=-=-=

Dear All,

I sent this to the list a couple of years back, but now that things are
moving again, and there are new eyes on the list, I thought I'd send it
again. I believe I'm the only person to use this (and might well
continue to be so) but I've been using it for a couple of years without
any problems, and it has made using message mode a lot more
convenient. As far as I know, this doesn't intersect with the recent
security problems pointed out in mml-mode, but I could be wrong.

My issue was this: the handling of (outgoing) attachments in
message-mode left 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 find tach.el attached to this email.

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 has remained at 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 it might fill a niche for some users, as notmuch's
popularity continues to grow.

Best,
Jesse



--=-=-=
Content-Type: application/emacs-lisp
Content-Disposition: attachment; filename=tach.el
Content-Transfer-Encoding: quoted-printable

;; 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:=20
;;   (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\.]+[K=
M]\\]\\)$")

(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)))
=20=20

(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)))
=20=20=20=20

(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=20
		(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=20
		    (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 (=3D (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)=20
	   (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 ((=3D (length file-lst) 0)
	       (setq idx 0))
	      (t
	       (setq idx (- orig-line (line-number-at-pos))))))
      (tach-write-list=20
       (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 (=3D 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=20
  		"*"
  		(replace-regexp-in-string=20
  		 "^\\(\**\\)\\(.*?\\)\\(\**\\)$" "\\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)))))



=20=20=20=20
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(provide 'tach)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


--=-=-=--